├── .gitignore ├── README.md ├── ch3 ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── action_table_letlang.txt ├── app │ ├── letlang │ │ ├── Env.hs │ │ ├── Expr.hs │ │ ├── Interp.hs │ │ ├── LetLang.lhs │ │ ├── Lexer.hs │ │ ├── Main.lhs │ │ ├── MainUtil.hs │ │ ├── Parser.hs │ │ ├── Token.hs │ │ └── examples │ │ │ ├── check_shadowing_in_body.let │ │ │ ├── check_shadowing_in_rhs.let │ │ │ ├── eval_let_body.let │ │ │ ├── eval_let_rhs.let │ │ │ ├── if_eval_test_false.let │ │ │ ├── if_eval_test_false_2.let │ │ │ ├── if_eval_test_true.let │ │ │ ├── if_eval_test_true_2.let │ │ │ ├── if_false.let │ │ │ ├── if_true.let │ │ │ ├── iszero.let │ │ │ ├── negative_const.let │ │ │ ├── nested_arith_left.let │ │ │ ├── nested_arith_right.let │ │ │ ├── no_bool_to_diff_1.let │ │ │ ├── no_bool_to_diff_2.let │ │ │ ├── no_int_to_if.let │ │ │ ├── positive_const.let │ │ │ ├── simple_arith_1.let │ │ │ ├── simple_arith_var_1.let │ │ │ ├── simple_let_1.let │ │ │ ├── simple_nested_let.let │ │ │ ├── test_unbound_var_1.let │ │ │ ├── test_unbound_var_2.let │ │ │ ├── test_var_1.let │ │ │ ├── test_var_2.let │ │ │ └── test_var_3.let │ ├── letreclang │ │ ├── Env.hs │ │ ├── Expr.hs │ │ ├── Interp.hs │ │ ├── Lexer.hs │ │ ├── Main.lhs │ │ ├── MainUtil.hs │ │ ├── Parser.hs │ │ ├── Token.hs │ │ └── examples │ │ │ ├── apply_proc_in_rator_pos.proc │ │ │ ├── apply_simple_proc.proc │ │ │ ├── check_shadowing_in_body.let │ │ │ ├── check_shadowing_in_rhs.let │ │ │ ├── eval_let_body.let │ │ │ ├── eval_let_rhs.let │ │ │ ├── ho_nested_letrecs.letrec │ │ │ ├── if_eval_test_false.let │ │ │ ├── if_eval_test_false_2.let │ │ │ ├── if_eval_test_true.let │ │ │ ├── if_eval_test_true_2.let │ │ │ ├── if_false.let │ │ │ ├── if_true.let │ │ │ ├── let_to_proc_1.proc │ │ │ ├── negative_const.let │ │ │ ├── nested_arith_left.let │ │ │ ├── nested_arith_right.let │ │ │ ├── nested_procs_1.proc │ │ │ ├── nested_procs_2.proc │ │ │ ├── no_bool_to_diff_1.let │ │ │ ├── no_bool_to_diff_2.let │ │ │ ├── no_int_to_if.let │ │ │ ├── positive_const.let │ │ │ ├── simple_arith_1.let │ │ │ ├── simple_arith_var_1.let │ │ │ ├── simple_let_1.let │ │ │ ├── simple_letrec_1.letrec │ │ │ ├── simple_letrec_2.letrec │ │ │ ├── simple_letrec_3.letrec │ │ │ ├── simple_nested_let.let │ │ │ ├── test_unbound_var_1.let │ │ │ ├── test_unbound_var_2.let │ │ │ ├── test_var_1.let │ │ │ ├── test_var_2.let │ │ │ ├── test_var_3.let │ │ │ └── y_combinator_1.proc │ └── proclang │ │ ├── Env.hs │ │ ├── Expr.hs │ │ ├── Interp.hs │ │ ├── Lexer.hs │ │ ├── Main.lhs │ │ ├── MainUtil.hs │ │ ├── Parser.hs │ │ ├── ProcLang.lhs │ │ ├── Token.hs │ │ └── examples │ │ ├── apply_proc_in_rator_pos.proc │ │ ├── apply_simple_proc.proc │ │ ├── check_shadowing_in_body.let │ │ ├── check_shadowing_in_rhs.let │ │ ├── eval_let_body.let │ │ ├── eval_let_rhs.let │ │ ├── if_eval_test_false.let │ │ ├── if_eval_test_false_2.let │ │ ├── if_eval_test_true.let │ │ ├── if_eval_test_true_2.let │ │ ├── if_false.let │ │ ├── if_true.let │ │ ├── let_to_proc_1.proc │ │ ├── negative_const.let │ │ ├── nested_arith_left.let │ │ ├── nested_arith_right.let │ │ ├── nested_procs_1.proc │ │ ├── nested_procs_2.proc │ │ ├── no_bool_to_diff_1.let │ │ ├── no_bool_to_diff_2.let │ │ ├── no_int_to_if.let │ │ ├── positive_const.let │ │ ├── simple_arith_1.let │ │ ├── simple_arith_var_1.let │ │ ├── simple_let_1.let │ │ ├── simple_nested_let.let │ │ ├── test_unbound_var_1.let │ │ ├── test_unbound_var_2.let │ │ ├── test_var_1.let │ │ ├── test_var_2.let │ │ ├── test_var_3.let │ │ └── y_combinator_1.proc ├── ch3.cabal ├── goto_table_letlang.txt ├── mygrammar_letlang.grm ├── mygrammar_letlang.grm.hash ├── package.yaml ├── prod_rules_letlang.txt ├── src │ └── Lib.hs ├── stack.yaml ├── stack.yaml.lock └── test │ ├── letlang │ └── Spec.hs │ ├── letreclang │ └── Spec.hs │ └── proclang │ └── Spec.hs ├── ch4 ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── app │ ├── explicitrefslang │ │ ├── Env.hs │ │ ├── Expr.hs │ │ ├── Interp.hs │ │ ├── Lexer.hs │ │ ├── Main.hs │ │ ├── MainUtil.hs │ │ ├── Parser.hs │ │ ├── Ref.hs │ │ ├── Store.hs │ │ ├── Token.hs │ │ └── examples │ │ │ ├── assignment_test_1.expref │ │ │ ├── begin_test_1.expref │ │ │ ├── chains_1.expref │ │ │ ├── check_shadowing_in_body.let │ │ │ ├── check_shadowing_in_rhs.let │ │ │ ├── eval_let_body.let │ │ │ ├── eval_let_rhs.let │ │ │ ├── even_odd_via_set_1.expref │ │ │ ├── gensym_test_1.expref │ │ │ ├── gensym_test_2.expref │ │ │ ├── ho_nested_letrecs.letrec │ │ │ ├── if_eval_test_false.let │ │ │ ├── if_eval_test_false_2.let │ │ │ ├── if_eval_test_true.let │ │ │ ├── if_eval_test_true_2.let │ │ │ ├── if_false.let │ │ │ ├── if_true.let │ │ │ ├── negative_const.let │ │ │ ├── nested_arith_left.let │ │ │ ├── nested_arith_right.let │ │ │ ├── nested_procs_1.proc │ │ │ ├── nested_procs_2.proc │ │ │ ├── no_bool_to_diff_1.let │ │ │ ├── no_bool_to_diff_2.let │ │ │ ├── no_int_to_if.let │ │ │ ├── positive_const.let │ │ │ ├── show_allocation_1.expref │ │ │ ├── simple_app_1.proc │ │ │ ├── simple_app_2.proc │ │ │ ├── simple_app_3.proc │ │ │ ├── simple_arith_1.let │ │ │ ├── simple_let_1.let │ │ │ ├── simple_letrec_1.letrec │ │ │ ├── simple_letrec_2.letrec │ │ │ ├── simple_letrec_3.letrec │ │ │ ├── simple_nested_let.let │ │ │ ├── simple_store_test_1.expref │ │ │ ├── test_unbound_var_1.let │ │ │ ├── test_unbound_var_2.let │ │ │ ├── test_var_1.let │ │ │ ├── test_var_2.let │ │ │ ├── test_var_3.let │ │ │ └── y_combinator_1.proc │ └── implicitrefslang │ │ ├── EnvStore.hs │ │ ├── Expr.hs │ │ ├── Interp.hs │ │ ├── Lexer.hs │ │ ├── Main.hs │ │ ├── MainUtil.hs │ │ ├── Parser.hs │ │ ├── Ref.hs │ │ ├── Token.hs │ │ ├── action_table_implicitrefslang.txt │ │ ├── examples │ │ ├── apply_proc_in_rator_pos.proc │ │ ├── apply_simple_proc.proc │ │ ├── assignment_test_1.impref │ │ ├── begin_test_1.letrec_ext │ │ ├── check_shadowing_in_body.let │ │ ├── check_shadowing_in_rhs.let │ │ ├── eval_let_body.let │ │ ├── eval_let_rhs.let │ │ ├── even_odd_via_set_1.impref │ │ ├── example_for_book_1.impref │ │ ├── gensym_test_1.impref │ │ ├── ho_nested_letrecs.letrec │ │ ├── if_eval_test_false.let │ │ ├── if_eval_test_false_2.let │ │ ├── if_eval_test_true.let │ │ ├── if_eval_test_true_2.let │ │ ├── if_false.let │ │ ├── if_true.let │ │ ├── let_to_proc_1.proc │ │ ├── negative_const.let │ │ ├── nested_arith_left.let │ │ ├── nested_arith_right.let │ │ ├── nested_procs_1.proc │ │ ├── nested_procs_2.proc │ │ ├── no_bool_to_diff_1.let │ │ ├── no_bool_to_diff_2.let │ │ ├── no_int_to_if.let │ │ ├── positive_const.let │ │ ├── simple_app_1.proc │ │ ├── simple_app_2.proc │ │ ├── simple_app_3.proc │ │ ├── simple_arith_1.let │ │ ├── simple_let_1.let │ │ ├── simple_letrec_1.letrec │ │ ├── simple_letrec_2.letrec │ │ ├── simple_letrec_3.letrec │ │ ├── simple_nested_let.let │ │ ├── test_unbound_var_1.let │ │ ├── test_unbound_var_2.let │ │ ├── test_var_1.let │ │ ├── test_var_2.let │ │ ├── test_var_3.let │ │ └── y_combinator_1.proc │ │ ├── goto_table_implicitrefslang.txt │ │ ├── mygrammar_implicitrefslang.grm │ │ ├── mygrammar_implicitrefslang.grm.hash │ │ └── prod_rules_implicitrefslang.txt ├── ch4.cabal ├── package.yaml ├── src │ └── Lib.hs ├── stack.yaml ├── stack.yaml.lock └── test │ ├── explicitrefslang │ └── Spec.hs │ └── implicitrefslang │ └── Spec.hs ├── ch5 ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── app │ ├── exceptions │ │ ├── Env.hs │ │ ├── Expr.hs │ │ ├── Interp.hs │ │ ├── Lexer.hs │ │ ├── Main.hs │ │ ├── MainUtil.hs │ │ ├── Parser.hs │ │ ├── Token.hs │ │ ├── examples │ │ │ ├── apply_proc_in_rator_pos.proc │ │ │ ├── apply_simple_proc.proc │ │ │ ├── car_1.exn │ │ │ ├── cdr_1.exn │ │ │ ├── check_shadowing_in_body.let │ │ │ ├── check_shadowing_in_rhs.let │ │ │ ├── dont_run_handler_til_failure.exn │ │ │ ├── eval_let_body.let │ │ │ ├── eval_let_rhs.let │ │ │ ├── exceptions_have_dynamic_scope_1.exn │ │ │ ├── handler_in_non_tail_recursive_position.exn │ │ │ ├── ho_nested_letrecs.letrec │ │ │ ├── if_eval_test_false.let │ │ │ ├── if_eval_test_false_2.let │ │ │ ├── if_eval_test_true.let │ │ │ ├── if_eval_test_true_2.let │ │ │ ├── if_false.let │ │ │ ├── if_true.let │ │ │ ├── let_to_proc_1.proc │ │ │ ├── lists_1.exn │ │ │ ├── negative_const.let │ │ │ ├── nested_arith_left.let │ │ │ ├── nested_arith_right.let │ │ │ ├── nested_procs_1.proc │ │ │ ├── nested_procs_2.proc │ │ │ ├── no_bool_to_diff_1.let │ │ │ ├── no_bool_to_diff_2.let │ │ │ ├── no_int_to_if.let │ │ │ ├── positive_const.let │ │ │ ├── propagate_error_1.exn │ │ │ ├── propagate_error_2.exn │ │ │ ├── simple_app_1.proc │ │ │ ├── simple_app_2.proc │ │ │ ├── simple_app_3.proc │ │ │ ├── simple_arith_1.let │ │ │ ├── simple_failure.exn │ │ │ ├── simple_let_1.let │ │ │ ├── simple_letrec_1.letrec │ │ │ ├── simple_letrec_2.letrec │ │ │ ├── simple_letrec_3.letrec │ │ │ ├── simple_nested_let.let │ │ │ ├── simple_succeed.exn │ │ │ ├── test_unbound_var_1.let │ │ │ ├── test_unbound_var_2.let │ │ │ ├── test_var_1.let │ │ │ ├── test_var_2.let │ │ │ ├── test_var_3.let │ │ │ ├── text_example_0_1.exn │ │ │ ├── text_example_0_2.exn │ │ │ ├── text_example_1_1.exn │ │ │ ├── text_example_1_2.exn │ │ │ ├── twice.letrec │ │ │ ├── twice.proc │ │ │ ├── uncaught_exception.exn │ │ │ └── y_combinator_1.proc │ │ └── exceptions.cabal │ ├── letreccps │ │ ├── Env.hs │ │ ├── Expr.hs │ │ ├── Interp.hs │ │ ├── Lexer.hs │ │ ├── Main.hs │ │ ├── MainUtil.hs │ │ ├── Parser.hs │ │ ├── Token.hs │ │ └── examples │ │ │ ├── apply_proc_in_rator_pos.proc │ │ │ ├── apply_simple_proc.proc │ │ │ ├── check_shadowing_in_body.let │ │ │ ├── check_shadowing_in_rhs.let │ │ │ ├── eval_let_body.let │ │ │ ├── eval_let_rhs.let │ │ │ ├── ho_nested_letrecs.letrec │ │ │ ├── if_eval_test_false.let │ │ │ ├── if_eval_test_false_2.let │ │ │ ├── if_eval_test_true.let │ │ │ ├── if_eval_test_true_2.let │ │ │ ├── if_false.let │ │ │ ├── if_true.let │ │ │ ├── let_to_proc_1.proc │ │ │ ├── negative_const.let │ │ │ ├── nested_arith_left.let │ │ │ ├── nested_arith_right.let │ │ │ ├── nested_procs_1.proc │ │ │ ├── nested_procs_2.proc │ │ │ ├── no_bool_to_diff_1.let │ │ │ ├── no_bool_to_diff_2.let │ │ │ ├── no_int_to_if.let │ │ │ ├── positive_const.let │ │ │ ├── simple_app_1.proc │ │ │ ├── simple_app_2.proc │ │ │ ├── simple_app_3.proc │ │ │ ├── simple_arith_1.let │ │ │ ├── simple_arith_var_1.let │ │ │ ├── simple_let_1.let │ │ │ ├── simple_letrec_1.letrec │ │ │ ├── simple_letrec_2.letrec │ │ │ ├── simple_letrec_3.letrec │ │ │ ├── simple_nested_let.let │ │ │ ├── test_unbound_var_1.let │ │ │ ├── test_unbound_var_2.let │ │ │ ├── test_var_1.let │ │ │ ├── test_var_2.let │ │ │ ├── test_var_3.let │ │ │ └── y_combinator_1.proc │ └── threads │ │ ├── EnvStore.hs │ │ ├── Expr.hs │ │ ├── Interp.hs │ │ ├── Lexer.hs │ │ ├── Main.hs │ │ ├── MainUtil.hs │ │ ├── Parser.hs │ │ ├── Queue.hs │ │ ├── Scheduler.hs │ │ ├── Semaphores.hs │ │ ├── Token.hs │ │ ├── examples │ │ ├── apply_proc_in_rator_pos.let │ │ ├── apply_simple_proc.let │ │ ├── assignment_test_1.impref │ │ ├── begin_1.impref │ │ ├── begin_2.impref │ │ ├── begin_test_1.letrec_ext │ │ ├── car_1.exn │ │ ├── cdr_1.exn │ │ ├── check_shadowing_in_body.let │ │ ├── check_shadowing_in_rhs.let │ │ ├── dont_run_handler_til_failure.exn │ │ ├── eval_let_body.let │ │ ├── eval_let_rhs.let │ │ ├── even_odd_via_set_1.impref │ │ ├── example_for_book_1.impref │ │ ├── exceptions_have_dynamic_scope_1.exn │ │ ├── gensym_test_1.impref │ │ ├── handler_in_non_tail_recursive_position.exn │ │ ├── ho_nested_letrecs.letrec │ │ ├── if_eval_test_false.let │ │ ├── if_eval_test_false_2.let │ │ ├── if_eval_test_true.let │ │ ├── if_eval_test_true_2.let │ │ ├── if_false.let │ │ ├── if_true.let │ │ ├── insanely_simple_spawn.thr │ │ ├── let_to_proc_1.let │ │ ├── lists_1.exn │ │ ├── negative_const.let │ │ ├── nested_arith_left.let │ │ ├── nested_arith_right.let │ │ ├── nested_procs_1.proc │ │ ├── nested_procs_2.proc │ │ ├── no_bool_to_diff_1.let │ │ ├── no_bool_to_diff_2.let │ │ ├── no_int_to_if.let │ │ ├── positive_const.let │ │ ├── producer_consumer.thr │ │ ├── producer_consumer_with_mutex.thr │ │ ├── propagate_error_1.exn │ │ ├── propagate_error_2.exn │ │ ├── safe_ctr.thr │ │ ├── simple_app_1.proc │ │ ├── simple_app_2.proc │ │ ├── simple_app_3.proc │ │ ├── simple_arith_1.let │ │ ├── simple_failure.exn │ │ ├── simple_let_1.let │ │ ├── simple_letrec_1.letrec │ │ ├── simple_letrec_2.letrec │ │ ├── simple_letrec_3.letrec │ │ ├── simple_nested_let.let │ │ ├── simple_succeed.exn │ │ ├── test_unbound_var_1.let │ │ ├── test_unbound_var_2.let │ │ ├── test_var_1.let │ │ ├── test_var_2.let │ │ ├── test_var_3.let │ │ ├── text_example_0_1.exn │ │ ├── text_example_0_2.exn │ │ ├── text_example_1_1.exn │ │ ├── text_example_1_2.exn │ │ ├── twice.letrec │ │ ├── two_non_cooperating_threads.thr │ │ ├── two_threads.thr │ │ ├── uncaught_exception.exn │ │ ├── unsafe_ctr.thr │ │ ├── unyielding_producer_consumer.thr │ │ └── y_combinator_1.proc │ │ └── exceptions.cabal ├── ch5.cabal ├── package.yaml ├── src │ └── Lib.hs ├── stack.yaml ├── stack.yaml.lock └── test │ ├── exceptions │ └── Spec.hs │ └── letreccps │ └── Spec.hs ├── ch7 ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── app │ └── checkedlang │ │ ├── Env.hs │ │ ├── Expr.hs │ │ ├── Interp.hs │ │ ├── Lexer.hs │ │ ├── Main.hs │ │ ├── MainUtil.hs │ │ ├── Parser.hs │ │ ├── Token.hs │ │ └── TypeCheck.hs ├── ch7.cabal ├── dist-newstyle │ └── cache │ │ └── config ├── package.yaml ├── src │ └── Lib.hs ├── stack.yaml ├── stack.yaml.lock └── test │ └── checkedlang │ ├── Spec.hs │ └── TypeCheckerTest.hs └── ch9 ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── app └── classes │ ├── EnvStore.hs │ ├── Expr.hs │ ├── Interp.hs │ ├── Lexer.hs │ ├── Main.hs │ ├── Parser.hs │ ├── Ref.hs │ └── Token.hs ├── ch9.cabal ├── dist-newstyle └── cache │ └── config ├── package.yaml ├── src └── Lib.hs ├── stack.yaml ├── stack.yaml.lock └── test └── classes └── Spec.hs /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.pdf 3 | *.log 4 | *.aux 5 | goto_table*.txt 6 | action_table*.txt 7 | *.grm 8 | *.grm.hash 9 | prod_rules*.txt 10 | .stack-work 11 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Exercise for The Essentials of Programming Languages (EOPL) in Haskell 2 | - https://github.com/kwanghoon/Lecture_EOPL 3 | 4 | ## 빌드 및 실행 방법 5 | - cd ch3 6 | - stack build (전체 빌드) 7 | - stack build ch3:exe:letlang-exe (개별 빌드) 8 | - stack run ch3:exe:letlang-exe (개별 실행) 9 | 10 | ## 테스트 방법 11 | - cd ch3 12 | - stack test (전체 테스트) 13 | - stack test ch3:test:letlang-test (개별 테스트) 14 | 15 | ## 동영상 강의 16 | - [YouTube: 프로그래밍언어 설계 및 구현](https://www.youtube.com/playlist?list=PLhbaMvGyp99982CpQoam-z9tqJ6qi_hw0) 17 | 18 | ## For learning the fundamentals of Haskell programming 19 | - [www.haskell.org](https://www.haskell.org) 20 | - [Haskell MOOC](https://haskell.mooc.fi) 21 | - [YouTube](https://www.youtube.com/playlist?list=PLhbaMvGyp99_NphAX7k5OqcM1fXLZne8t) 22 | 23 | ## Authors 24 | - Kwanghoon Choi 25 | 26 | ## About SWLAB 27 | - SWLAB, short for Software Languages and Systems Laboratory, is located at Chonnam National University in Gwangju, Republic of Korea. Our focus is on the research and development of programming languages, compilers, and software engineering. For more information, please visit [our website](https://kwanghoon.github.io). 28 | 29 | -------------------------------------------------------------------------------- /ch3/.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ -------------------------------------------------------------------------------- /ch3/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for ch3 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /ch3/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2022 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ch3/README.md: -------------------------------------------------------------------------------- 1 | # ch3 2 | -------------------------------------------------------------------------------- /ch3/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ch3/app/letlang/Env.hs: -------------------------------------------------------------------------------- 1 | module Env where 2 | 3 | import Expr 4 | 5 | data Env = Empty_Env 6 | | Extend_Env Identifier ExpVal Env 7 | deriving (Show) 8 | 9 | 10 | empty_env :: Env 11 | empty_env = Empty_Env 12 | 13 | extend_env :: Identifier -> ExpVal -> Env -> Env 14 | extend_env = Extend_Env 15 | 16 | apply_env :: Env -> Identifier -> ExpVal 17 | apply_env Empty_Env x = error (x ++ " is not found.") 18 | apply_env (Extend_Env y v env) x 19 | | x == y = v 20 | | otherwise = apply_env env x 21 | 22 | data ExpVal = 23 | Num_Val {expval_num :: Int} 24 | | Bool_Val {expval_bool :: Bool} 25 | 26 | instance Show ExpVal where 27 | show (Num_Val num) = show num 28 | show (Bool_Val bool) = show bool 29 | 30 | type DenVal = ExpVal 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /ch3/app/letlang/Expr.hs: -------------------------------------------------------------------------------- 1 | module Expr where 2 | 3 | type Program = Exp 4 | 5 | data Exp = 6 | Const_Exp Int 7 | | Diff_Exp Exp Exp 8 | | IsZero_Exp Exp 9 | | If_Exp Exp Exp Exp 10 | | Var_Exp Identifier 11 | | Let_Exp Identifier Exp Exp 12 | deriving Show 13 | 14 | type Identifier = String -------------------------------------------------------------------------------- /ch3/app/letlang/Interp.hs: -------------------------------------------------------------------------------- 1 | module Interp where 2 | 3 | import Expr 4 | import Env 5 | 6 | -- 7 | value_of :: Exp -> Env -> ExpVal 8 | 9 | value_of (Const_Exp n) env = 10 | error "TODO: implement a value_of function" 11 | 12 | value_of (Var_Exp var) env = 13 | error "TODO: implement a value_of function" 14 | 15 | value_of (Diff_Exp exp1 exp2) env = 16 | error "TODO: implement a value_of function" 17 | 18 | value_of (IsZero_Exp exp) env = 19 | error "TODO: implement a value_of function" 20 | 21 | value_of (If_Exp exp1 exp2 exp3) env = 22 | error "TODO: implement a value_of function" 23 | 24 | value_of (Let_Exp var exp1 body) env = 25 | error "TODO: implement a value_of function" 26 | 27 | 28 | -- 29 | value_of_program :: Exp -> ExpVal 30 | 31 | value_of_program exp = error "TODO: implement a value_of_program function" 32 | 33 | initEnv :: Env 34 | initEnv = extend_env "i" (Num_Val 1) 35 | (extend_env "v" (Num_Val 5) 36 | (extend_env "x" (Num_Val 10) empty_env)) 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /ch3/app/letlang/LetLang.lhs: -------------------------------------------------------------------------------- 1 | > module LetLang where 2 | > 3 | > letlang = "LetLang" 4 | > 5 | -------------------------------------------------------------------------------- /ch3/app/letlang/Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer(lexerSpec) where 2 | 3 | import Prelude hiding (EQ) 4 | import CommonParserUtil 5 | import Token 6 | 7 | mkFn :: Token -> LexAction Token IO () 8 | mkFn tok = \text -> return $ Just tok 9 | 10 | skip :: LexAction Token IO () 11 | skip = \text -> return $ Nothing 12 | 13 | lexerSpec :: LexerSpec Token IO () 14 | lexerSpec = LexerSpec 15 | { 16 | endOfToken = END_OF_TOKEN, 17 | lexerSpecList = 18 | [ ("[ \t\n]" , skip), 19 | 20 | ("[0-9]+" , mkFn INTEGER_NUMBER), 21 | 22 | ("\\-" , mkFn SUB), 23 | ("\\(" , mkFn OPEN_PAREN), 24 | ("\\)" , mkFn CLOSE_PAREN), 25 | ("\\," , mkFn COMMA), 26 | 27 | ("zero\\?" , mkFn ISZERO), 28 | 29 | ("if" , mkFn IF), 30 | ("then" , mkFn THEN), 31 | ("else" , mkFn ELSE), 32 | 33 | ("let" , mkFn LET), 34 | ("in" , mkFn IN), 35 | ("\\=" , mkFn EQ), 36 | 37 | ("[a-zA-Z][a-zA-Z0-9]*" , mkFn IDENTIFIER) 38 | ] 39 | } 40 | -------------------------------------------------------------------------------- /ch3/app/letlang/Main.lhs: -------------------------------------------------------------------------------- 1 | > module Main where 2 | > 3 | > import CommonParserUtil 4 | 5 | > import TokenInterface 6 | > import Lexer 7 | > import Terminal 8 | > import Parser 9 | > import Expr 10 | > import Interp 11 | 12 | > import Control.Monad (when) 13 | > import System.IO 14 | > import System.Environment (getArgs, withArgs) 15 | > 16 | > main :: IO () 17 | > main = 18 | > do args <- getArgs 19 | > _main args 20 | > 21 | > 22 | > _main [] = return () 23 | > _main (fileName:args) = 24 | > case fileName of 25 | > _ -> do _ <- doProcess True fileName 26 | > _main args 27 | 28 | 29 | > doProcess verbose fileName = do 30 | > text <- readFile fileName 31 | > let debugFlag = False 32 | > 33 | > expression <- 34 | > parsing debugFlag 35 | > parserSpec ((), 1, 1, text) 36 | > (aLexer lexerSpec) 37 | > (fromToken (endOfToken lexerSpec)) 38 | 39 | > putStrLn (show expression) 40 | > 41 | > let val = value_of_program expression 42 | > putStrLn (show val) 43 | 44 | > parser text = do 45 | > parsing False 46 | > parserSpec ((), 1, 1, text) 47 | > (aLexer lexerSpec) 48 | > (fromToken (endOfToken lexerSpec)) 49 | 50 | > run text = do 51 | > expression <- parser text 52 | > putStrLn (show expression) 53 | > 54 | > let val = value_of_program expression 55 | > putStrLn (show val) 56 | -------------------------------------------------------------------------------- /ch3/app/letlang/MainUtil.hs: -------------------------------------------------------------------------------- 1 | module MainUtil where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | parser text = do 17 | parsing False -- parser converting a text-based program 18 | parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 19 | (aLexer lexerSpec) 20 | (fromToken (endOfToken lexerSpec)) 21 | 22 | run text = do 23 | val <- runProg text True 24 | putStrLn (show val) 25 | 26 | runProg text bool = do 27 | expression <- parser text 28 | 29 | if bool then putStrLn (show expression) else return () 30 | 31 | let val = value_of_program expression -- interpreter 32 | return val 33 | -------------------------------------------------------------------------------- /ch3/app/letlang/Parser.hs: -------------------------------------------------------------------------------- 1 | module Parser where 2 | 3 | import CommonParserUtil 4 | import Token 5 | import Expr 6 | 7 | -- | Utility 8 | rule prodRule action = (prodRule, action, Nothing ) 9 | ruleWithPrec prodRule action prec = (prodRule, action, Just prec) 10 | 11 | -- 12 | parserSpec :: ParserSpec Token Exp IO () 13 | parserSpec = ParserSpec 14 | { 15 | startSymbol = "Expression'", 16 | 17 | tokenPrecAssoc = [], 18 | 19 | parserSpecList = 20 | [ 21 | rule "Expression' -> Expression" (\rhs -> return $ get rhs 1), 22 | 23 | rule "Expression -> integer_number" 24 | (\rhs -> return $ Const_Exp (read (getText rhs 1) :: Int)), 25 | 26 | rule "Expression -> - integer_number" 27 | (\rhs -> return $ Const_Exp (-(read (getText rhs 2) :: Int))), 28 | 29 | rule "Expression -> - ( Expression , Expression )" 30 | (\rhs -> return $ Diff_Exp (get rhs 3) (get rhs 5)), 31 | 32 | rule "Expression -> zero? ( Expression )" 33 | (\rhs -> return $ IsZero_Exp (get rhs 3)), 34 | 35 | rule "Expression -> if Expression then Expression else Expression" 36 | (\rhs -> return $ If_Exp (get rhs 2) (get rhs 4) (get rhs 6)), 37 | 38 | rule "Expression -> identifier" (\rhs -> return $ Var_Exp (getText rhs 1)), 39 | 40 | rule "Expression -> let identifier = Expression in Expression" 41 | (\rhs -> return $ Let_Exp (getText rhs 2) (get rhs 4) (get rhs 6)) 42 | ], 43 | 44 | baseDir = "./", 45 | actionTblFile = "action_table_letlang.txt", 46 | gotoTblFile = "goto_table_letlang.txt", 47 | grammarFile = "prod_rules_letlang.txt", 48 | parserSpecFile = "mygrammar_letlang.grm", 49 | genparserexe = "yapb-exe" 50 | } 51 | 52 | 53 | -------------------------------------------------------------------------------- /ch3/app/letlang/Token.hs: -------------------------------------------------------------------------------- 1 | module Token(Token(..)) where 2 | 3 | import Prelude hiding(EQ) 4 | import TokenInterface 5 | 6 | data Token = 7 | END_OF_TOKEN 8 | 9 | | INTEGER_NUMBER -- number 10 | 11 | | SUB -- - ( expr1, expr2 ) 12 | | OPEN_PAREN | CLOSE_PAREN 13 | | COMMA 14 | 15 | | ISZERO -- zero? ( expr ) 16 | 17 | | IF -- if expr1 then expr2 else expr3 18 | | THEN 19 | | ELSE 20 | 21 | | LET -- let identifier = expr1 in expr2 22 | | IN 23 | | EQ 24 | 25 | | IDENTIFIER -- identifier 26 | deriving (Eq, Show) 27 | 28 | tokenStrList :: [(Token,String)] 29 | tokenStrList = 30 | [ (END_OF_TOKEN, "$"), 31 | 32 | (INTEGER_NUMBER, "integer_number"), 33 | 34 | (SUB, "-"), 35 | (OPEN_PAREN, "("), 36 | (CLOSE_PAREN, ")"), 37 | (COMMA, ","), 38 | 39 | (ISZERO, "zero?"), 40 | 41 | (IF, "if"), 42 | (THEN, "then"), 43 | (ELSE, "else"), 44 | 45 | (IDENTIFIER, "identifier"), 46 | 47 | (LET, "let"), 48 | (IN, "in"), 49 | (EQ, "=") 50 | ] 51 | 52 | findTok tok [] = Nothing 53 | findTok tok ((tok_,str):list) 54 | | tok == tok_ = Just str 55 | | otherwise = findTok tok list 56 | 57 | findStr str [] = Nothing 58 | findStr str ((tok,str_):list) 59 | | str == str_ = Just tok 60 | | otherwise = findStr str list 61 | 62 | instance TokenInterface Token where 63 | -- toToken str = 64 | -- case findStr str tokenStrList of 65 | -- Nothing -> error ("toToken: " ++ str) 66 | -- Just tok -> tok 67 | fromToken tok = 68 | case findTok tok tokenStrList of 69 | Nothing -> error ("fromToken: " ++ show tok) 70 | Just str -> str 71 | 72 | 73 | isEOT END_OF_TOKEN = True 74 | isEOT _ = False 75 | -------------------------------------------------------------------------------- /ch3/app/letlang/examples/check_shadowing_in_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = 4 in x -------------------------------------------------------------------------------- /ch3/app/letlang/examples/check_shadowing_in_rhs.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = -(x,1) in x -------------------------------------------------------------------------------- /ch3/app/letlang/examples/eval_let_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in -(x,1) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/eval_let_rhs.let: -------------------------------------------------------------------------------- 1 | let x = -(4,1) in -(x,1) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/if_eval_test_false.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/letlang/examples/if_eval_test_false_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then foo else 4 -------------------------------------------------------------------------------- /ch3/app/letlang/examples/if_eval_test_true.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/letlang/examples/if_eval_test_true_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else foo -------------------------------------------------------------------------------- /ch3/app/letlang/examples/if_false.let: -------------------------------------------------------------------------------- 1 | if zero?(1) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/letlang/examples/if_true.let: -------------------------------------------------------------------------------- 1 | if zero?(0) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/letlang/examples/iszero.let: -------------------------------------------------------------------------------- 1 | zero?(x) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/negative_const.let: -------------------------------------------------------------------------------- 1 | -33 -------------------------------------------------------------------------------- /ch3/app/letlang/examples/nested_arith_left.let: -------------------------------------------------------------------------------- 1 | -(-(44,33),22) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/nested_arith_right.let: -------------------------------------------------------------------------------- 1 | -(55,-(22,11)) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/no_bool_to_diff_1.let: -------------------------------------------------------------------------------- 1 | -(zero?(0),1) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/no_bool_to_diff_2.let: -------------------------------------------------------------------------------- 1 | -(1,zero?(0)) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/no_int_to_if.let: -------------------------------------------------------------------------------- 1 | if 1 then 2 else 3 2 | -------------------------------------------------------------------------------- /ch3/app/letlang/examples/positive_const.let: -------------------------------------------------------------------------------- 1 | 11 -------------------------------------------------------------------------------- /ch3/app/letlang/examples/simple_arith_1.let: -------------------------------------------------------------------------------- 1 | -(44,33) 2 | -------------------------------------------------------------------------------- /ch3/app/letlang/examples/simple_arith_var_1.let: -------------------------------------------------------------------------------- 1 | -(44,x) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/simple_let_1.let: -------------------------------------------------------------------------------- 1 | let x = 3 in x -------------------------------------------------------------------------------- /ch3/app/letlang/examples/simple_nested_let.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let y = 4 in -(x,y) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/test_unbound_var_1.let: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /ch3/app/letlang/examples/test_unbound_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,foo) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/test_var_1.let: -------------------------------------------------------------------------------- 1 | x -------------------------------------------------------------------------------- /ch3/app/letlang/examples/test_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,1) -------------------------------------------------------------------------------- /ch3/app/letlang/examples/test_var_3.let: -------------------------------------------------------------------------------- 1 | -(1,x) -------------------------------------------------------------------------------- /ch3/app/letreclang/Env.hs: -------------------------------------------------------------------------------- 1 | module Env where 2 | 3 | import Expr (Identifier,Exp) 4 | 5 | -- Environment 6 | data Env = 7 | Empty_env 8 | | Extend_env Identifier ExpVal Env 9 | | Extend_env_rec Identifier Identifier Exp Env 10 | 11 | empty_env :: Env 12 | empty_env = Empty_env 13 | 14 | apply_env :: Env -> Identifier -> ExpVal 15 | apply_env Empty_env search_var = error (search_var ++ " is not found.") 16 | apply_env (Extend_env saved_var saved_val saved_env) search_var 17 | | search_var==saved_var = saved_val 18 | | otherwise = apply_env saved_env search_var 19 | apply_env (Extend_env_rec p_name b_var p_body saved_env) search_var 20 | | p_name==search_var = Proc_Val (procedure b_var p_body (Extend_env_rec p_name b_var p_body saved_env)) 21 | | otherwise = apply_env saved_env search_var 22 | 23 | extend_env :: Identifier -> ExpVal -> Env -> Env 24 | extend_env x v env = Extend_env x v env 25 | 26 | extend_env_rec :: Identifier -> Identifier -> Exp -> Env -> Env 27 | extend_env_rec f x exp env = Extend_env_rec f x exp env 28 | 29 | -- Expressed values 30 | data ExpVal = 31 | Num_Val {expval_num :: Int} 32 | | Bool_Val {expval_bool :: Bool} 33 | | Proc_Val {expval_proc :: Proc} 34 | 35 | instance Show ExpVal where 36 | show (Num_Val num) = show num 37 | show (Bool_Val bool) = show bool 38 | show (Proc_Val proc) = show "" 39 | 40 | -- Denoted values 41 | type DenVal = ExpVal 42 | 43 | -- Procedure values : data structures 44 | data Proc = Procedure {var :: Identifier, body :: Exp, saved_env :: Env} 45 | 46 | procedure :: Identifier -> Exp -> Env -> Proc 47 | procedure var body env = Procedure var body env 48 | 49 | -- In Interp.hs 50 | -- apply_procedure :: Proc -> ExpVal -> ExpVal 51 | 52 | -------------------------------------------------------------------------------- /ch3/app/letreclang/Expr.hs: -------------------------------------------------------------------------------- 1 | module Expr(Program,Exp(..),Identifier) where 2 | 3 | type Program = Exp 4 | 5 | data Exp = 6 | Const_Exp Int 7 | | Diff_Exp Exp Exp 8 | | IsZero_Exp Exp 9 | | If_Exp Exp Exp Exp 10 | | Var_Exp Identifier 11 | | Let_Exp Identifier Exp Exp -- let x = exp in exp 12 | | Letrec_Exp Identifier Identifier Exp Exp -- letrec f(arg) = ... recusive expr ... in ... f ... 13 | | Proc_Exp Identifier Exp -- proc (arg) exp 14 | | Call_Exp Exp Exp -- call 15 | deriving Show 16 | 17 | type Identifier = String 18 | 19 | -------------------------------------------------------------------------------- /ch3/app/letreclang/Interp.hs: -------------------------------------------------------------------------------- 1 | module Interp where 2 | 3 | import Expr 4 | import Env 5 | 6 | -- 7 | value_of :: Exp -> Env -> ExpVal 8 | 9 | value_of (Const_Exp n) env = 10 | error "TODO: implement a value_of function" 11 | 12 | value_of (Var_Exp var) env = 13 | error "TODO: implement a value_of function" 14 | 15 | value_of (Diff_Exp exp1 exp2) env = 16 | error "TODO: implement a value_of function" 17 | 18 | value_of (IsZero_Exp exp) env = 19 | error "TODO: implement a value_of function" 20 | 21 | value_of (If_Exp exp1 exp2 exp3) env = 22 | error "TODO: implement a value_of function" 23 | 24 | 25 | value_of (Let_Exp var exp1 body) env = 26 | error "TODO: implement a value_of function" 27 | 28 | value_of (Letrec_Exp proc_name bound_var proc_body letrec_body) env = 29 | error "TODO: implement a value_of function" 30 | 31 | value_of (Proc_Exp var body) env = 32 | error "TODO: implement a value_of function" 33 | 34 | value_of (Call_Exp rator rand) env = 35 | error "TODO: implement a value_of function" 36 | 37 | -- 38 | value_of_program :: Exp -> ExpVal 39 | 40 | value_of_program exp = 41 | error "TODO: implement a value_of_program function" 42 | 43 | 44 | 45 | -- 46 | initEnv = extend_env "i" (Num_Val 1) 47 | (extend_env "v" (Num_Val 5) 48 | (extend_env "x" (Num_Val 10) empty_env)) 49 | 50 | -- 51 | apply_procedure :: Proc -> ExpVal -> ExpVal 52 | apply_procedure proc arg = 53 | error "TODO: implement an apply_procedure function" 54 | 55 | 56 | -------------------------------------------------------------------------------- /ch3/app/letreclang/Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer(lexerSpec) where 2 | 3 | import Prelude hiding (EQ) 4 | import CommonParserUtil 5 | import Token 6 | 7 | mkFn :: Token -> LexAction Token IO () 8 | mkFn tok = \text -> return $ Just tok 9 | 10 | skip :: LexAction Token IO () 11 | skip = \text -> return $ Nothing 12 | 13 | lexerSpec :: LexerSpec Token IO () 14 | lexerSpec = LexerSpec 15 | { 16 | endOfToken = END_OF_TOKEN, 17 | lexerSpecList = 18 | [ ("[ \t\n]" , skip), 19 | 20 | ("[0-9]+" , mkFn INTEGER_NUMBER), 21 | 22 | ("\\-" , mkFn SUB), 23 | ("\\(" , mkFn OPEN_PAREN), 24 | ("\\)" , mkFn CLOSE_PAREN), 25 | ("\\," , mkFn COMMA), 26 | 27 | ("zero\\?" , mkFn ISZERO), 28 | 29 | ("if" , mkFn IF), 30 | ("then" , mkFn THEN), 31 | ("else" , mkFn ELSE), 32 | 33 | ("letrec" , mkFn LETREC), 34 | 35 | ("let" , mkFn LET), 36 | ("in" , mkFn IN), 37 | ("\\=" , mkFn EQ), 38 | 39 | ("proc" , mkFn PROC), 40 | 41 | ("[a-zA-Z][a-zA-Z0-9]*" , mkFn IDENTIFIER) 42 | ] 43 | } 44 | -------------------------------------------------------------------------------- /ch3/app/letreclang/Main.lhs: -------------------------------------------------------------------------------- 1 | > module Main where 2 | > 3 | > import CommonParserUtil 4 | 5 | > import TokenInterface 6 | > import Lexer 7 | > import Terminal 8 | > import Parser 9 | > import Expr 10 | > import Interp 11 | 12 | > import Control.Monad (when) 13 | > import System.IO 14 | > import System.Environment (getArgs, withArgs) 15 | > 16 | > main :: IO () 17 | > main = 18 | > do args <- getArgs 19 | > _main args 20 | > 21 | > 22 | > _main [] = return () 23 | > _main (fileName:args) = 24 | > case fileName of 25 | > _ -> do _ <- doProcess True fileName 26 | > _main args 27 | 28 | 29 | > doProcess verbose fileName = do 30 | > text <- readFile fileName 31 | > let debugFlag = False 32 | > 33 | > expression <- 34 | > parsing debugFlag 35 | > parserSpec ((), 1, 1, text) 36 | > (aLexer lexerSpec) 37 | > (fromToken (endOfToken lexerSpec)) 38 | 39 | > putStrLn (show expression) 40 | > 41 | > let val = value_of_program expression 42 | > putStrLn (show val) 43 | 44 | > parser text = do 45 | > parsing False 46 | > parserSpec ((), 1, 1, text) 47 | > (aLexer lexerSpec) 48 | > (fromToken (endOfToken lexerSpec)) 49 | > 50 | > run text = do 51 | > expression <- parser text 52 | > putStrLn (show expression) 53 | > 54 | > let val = value_of_program expression 55 | > putStrLn (show val) 56 | -------------------------------------------------------------------------------- /ch3/app/letreclang/MainUtil.hs: -------------------------------------------------------------------------------- 1 | module MainUtil where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | parser text = do 17 | parsing False -- parser converting a text-based program 18 | parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 19 | (aLexer lexerSpec) 20 | (fromToken (endOfToken lexerSpec)) 21 | 22 | run text = do 23 | val <- runProg text True 24 | putStrLn (show val) 25 | 26 | runProg text bool = do 27 | expression <- parser text 28 | 29 | if bool then putStrLn (show expression) else return () 30 | 31 | let val = value_of_program expression -- interpreter 32 | return val 33 | -------------------------------------------------------------------------------- /ch3/app/letreclang/Parser.hs: -------------------------------------------------------------------------------- 1 | module Parser where 2 | 3 | import CommonParserUtil 4 | import Token 5 | import Expr 6 | 7 | -- | Utility 8 | rule prodRule action = (prodRule, action, Nothing ) 9 | ruleWithPrec prodRule action prec = (prodRule, action, Just prec) 10 | 11 | -- 12 | parserSpec :: ParserSpec Token Exp IO () 13 | parserSpec = ParserSpec 14 | { 15 | startSymbol = "Expression'", 16 | 17 | tokenPrecAssoc = [], 18 | 19 | parserSpecList = 20 | [ 21 | rule "Expression' -> Expression" (\rhs -> return $ get rhs 1), 22 | 23 | rule "Expression -> integer_number" 24 | (\rhs -> return $ Const_Exp (read (getText rhs 1) :: Int)), 25 | 26 | rule "Expression -> - integer_number" 27 | (\rhs -> return $ Const_Exp (-(read (getText rhs 2) :: Int))), 28 | 29 | rule "Expression -> - ( Expression , Expression )" 30 | (\rhs -> return $ Diff_Exp (get rhs 3) (get rhs 5)), 31 | 32 | rule "Expression -> zero? ( Expression )" 33 | (\rhs -> return $ IsZero_Exp (get rhs 3)), 34 | 35 | rule "Expression -> if Expression then Expression else Expression" 36 | (\rhs -> return $ If_Exp (get rhs 2) (get rhs 4) (get rhs 6)), 37 | 38 | rule "Expression -> identifier" (\rhs -> return $ Var_Exp (getText rhs 1)), 39 | 40 | rule "Expression -> let identifier = Expression in Expression" 41 | (\rhs -> return $ Let_Exp (getText rhs 2) (get rhs 4) (get rhs 6)), 42 | 43 | rule "Expression -> letrec identifier ( identifier ) = Expression in Expression" 44 | (\rhs -> return $ Letrec_Exp (getText rhs 2) (getText rhs 4) (get rhs 7) (get rhs 9)), 45 | 46 | rule "Expression -> proc ( identifier ) Expression" 47 | (\rhs -> return $ Proc_Exp (getText rhs 3) (get rhs 5)), 48 | 49 | rule "Expression -> ( Expression Expression )" 50 | (\rhs -> return $ Call_Exp (get rhs 2) (get rhs 3)) 51 | ], 52 | 53 | baseDir = "./", 54 | actionTblFile = "action_table_letreclang.txt", 55 | gotoTblFile = "goto_table_letreclang.txt", 56 | grammarFile = "prod_rules_letreclang.txt", 57 | parserSpecFile = "mygrammar_letreclang.grm", 58 | genparserexe = "yapb-exe" 59 | } 60 | 61 | 62 | -------------------------------------------------------------------------------- /ch3/app/letreclang/Token.hs: -------------------------------------------------------------------------------- 1 | module Token(Token(..)) where 2 | 3 | import Prelude hiding(EQ) 4 | import TokenInterface 5 | 6 | data Token = 7 | END_OF_TOKEN 8 | 9 | | INTEGER_NUMBER -- number 10 | 11 | | SUB -- - ( expr1, expr2 ) 12 | | OPEN_PAREN | CLOSE_PAREN 13 | | COMMA 14 | 15 | | ISZERO -- zero? ( expr ) 16 | 17 | | IF -- if expr1 then expr2 else expr3 18 | | THEN 19 | | ELSE 20 | 21 | | LET -- let identifier = expr1 in expr2 22 | | IN 23 | | EQ 24 | 25 | | LETREC -- letrec identifier ( identifier )= expr1 in expr2 26 | 27 | | PROC -- proc ( identifier ) expr 28 | -- (expr1 expr2) 29 | 30 | | IDENTIFIER -- identifier 31 | deriving (Eq, Show) 32 | 33 | tokenStrList :: [(Token,String)] 34 | tokenStrList = 35 | [ (END_OF_TOKEN, "$"), 36 | 37 | (INTEGER_NUMBER, "integer_number"), 38 | 39 | (SUB, "-"), 40 | (OPEN_PAREN, "("), 41 | (CLOSE_PAREN, ")"), 42 | (COMMA, ","), 43 | 44 | (ISZERO, "zero?"), 45 | 46 | (IF, "if"), 47 | (THEN, "then"), 48 | (ELSE, "else"), 49 | 50 | (IDENTIFIER, "identifier"), 51 | 52 | (LET, "let"), 53 | (IN, "in"), 54 | (EQ, "="), 55 | 56 | (LETREC, "letrec"), 57 | 58 | (PROC, "proc") 59 | ] 60 | 61 | findTok tok [] = Nothing 62 | findTok tok ((tok_,str):list) 63 | | tok == tok_ = Just str 64 | | otherwise = findTok tok list 65 | 66 | findStr str [] = Nothing 67 | findStr str ((tok,str_):list) 68 | | str == str_ = Just tok 69 | | otherwise = findStr str list 70 | 71 | instance TokenInterface Token where 72 | -- toToken str = 73 | -- case findStr str tokenStrList of 74 | -- Nothing -> error ("toToken: " ++ str) 75 | -- Just tok -> tok 76 | fromToken tok = 77 | case findTok tok tokenStrList of 78 | Nothing -> error ("fromToken: " ++ show tok) 79 | Just str -> str 80 | 81 | 82 | isEOT END_OF_TOKEN = True 83 | isEOT _ = False 84 | -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/apply_proc_in_rator_pos.proc: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/apply_simple_proc.proc: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/check_shadowing_in_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = 4 in x -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/check_shadowing_in_rhs.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = -(x,1) in x -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/eval_let_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in -(x,1) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/eval_let_rhs.let: -------------------------------------------------------------------------------- 1 | let x = -(4,1) in -(x,1) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/ho_nested_letrecs.letrec: -------------------------------------------------------------------------------- 1 | letrec even(odd) = proc(x) if zero?(x) then 1 else (odd -(x,1)) 2 | in letrec odd(x) = if zero?(x) then 0 else ((even odd) -(x,1)) 3 | in (odd 13) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/if_eval_test_false.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/if_eval_test_false_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then foo else 4 -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/if_eval_test_true.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/if_eval_test_true_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else foo -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/if_false.let: -------------------------------------------------------------------------------- 1 | if zero?(1) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/if_true.let: -------------------------------------------------------------------------------- 1 | if zero?(0) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/let_to_proc_1.proc: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/negative_const.let: -------------------------------------------------------------------------------- 1 | -33 -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/nested_arith_left.let: -------------------------------------------------------------------------------- 1 | -(-(44,33),22) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/nested_arith_right.let: -------------------------------------------------------------------------------- 1 | -(55,-(22,11)) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/nested_procs_1.proc: -------------------------------------------------------------------------------- 1 | ((proc (x) proc (y) -(x,y) 5) 6) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/nested_procs_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/no_bool_to_diff_1.let: -------------------------------------------------------------------------------- 1 | -(zero?(0),1) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/no_bool_to_diff_2.let: -------------------------------------------------------------------------------- 1 | -(1,zero?(0)) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/no_int_to_if.let: -------------------------------------------------------------------------------- 1 | if 1 then 2 else 3 2 | -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/positive_const.let: -------------------------------------------------------------------------------- 1 | 11 -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/simple_arith_1.let: -------------------------------------------------------------------------------- 1 | -(44,33) 2 | -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/simple_arith_var_1.let: -------------------------------------------------------------------------------- 1 | -(44,x) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/simple_let_1.let: -------------------------------------------------------------------------------- 1 | let x = 3 in x -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/simple_letrec_1.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = -(x,1) in (f 33) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/simple_letrec_2.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/simple_letrec_3.letrec: -------------------------------------------------------------------------------- 1 | let m = -5 2 | in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/simple_nested_let.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let y = 4 in -(x,y) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/test_unbound_var_1.let: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/test_unbound_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,foo) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/test_var_1.let: -------------------------------------------------------------------------------- 1 | x -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/test_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,1) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/test_var_3.let: -------------------------------------------------------------------------------- 1 | -(1,x) -------------------------------------------------------------------------------- /ch3/app/letreclang/examples/y_combinator_1.proc: -------------------------------------------------------------------------------- 1 | let fix = proc (f) 2 | let d = proc (x) proc (z) ((f (x x)) z) 3 | in proc (n) ((f (d d)) n) 4 | in let 5 | t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4) 6 | in let times4 = (fix t4m) 7 | in (times4 3) -------------------------------------------------------------------------------- /ch3/app/proclang/Env.hs: -------------------------------------------------------------------------------- 1 | module Env where 2 | 3 | import Expr (Identifier,Exp) 4 | 5 | -- Environment 6 | data Env = Empty_Env 7 | | Extend_Env Identifier ExpVal Env 8 | deriving (Show) 9 | 10 | 11 | empty_env :: Env 12 | empty_env = Empty_Env 13 | 14 | extend_env :: Identifier -> ExpVal -> Env -> Env 15 | extend_env = Extend_Env 16 | 17 | apply_env :: Env -> Identifier -> ExpVal 18 | apply_env Empty_Env x = error (x ++ " is not found.") 19 | apply_env (Extend_Env y v env) x 20 | | x == y = v 21 | | otherwise = apply_env env x 22 | 23 | 24 | -- Expressed values 25 | data ExpVal = 26 | Num_Val {expval_num :: Int} 27 | | Bool_Val {expval_bool :: Bool} 28 | | Proc_Val {expval_proc :: Proc} 29 | 30 | instance Show ExpVal where 31 | show (Num_Val num) = show num 32 | show (Bool_Val bool) = show bool 33 | show (Proc_Val proc) = show "" 34 | 35 | -- Denoted values 36 | type DenVal = ExpVal 37 | 38 | -- Procedure values : data structures 39 | data Proc = Procedure {var :: Identifier, body :: Exp, saved_env :: Env} 40 | 41 | procedure :: Identifier -> Exp -> Env -> Proc 42 | procedure var body env = Procedure var body env 43 | 44 | -- In Interp.hs 45 | -- apply_procedure :: Proc -> ExpVal -> ExpVal 46 | 47 | -------------------------------------------------------------------------------- /ch3/app/proclang/Expr.hs: -------------------------------------------------------------------------------- 1 | module Expr(Program,Exp(..),Identifier) where 2 | 3 | type Program = Exp 4 | 5 | data Exp = 6 | Const_Exp Int 7 | | Diff_Exp Exp Exp 8 | | IsZero_Exp Exp 9 | | If_Exp Exp Exp Exp 10 | | Var_Exp Identifier 11 | | Let_Exp Identifier Exp Exp 12 | | Proc_Exp Identifier Exp -- proc 13 | | Call_Exp Exp Exp -- call 14 | deriving Show 15 | 16 | type Identifier = String 17 | 18 | -------------------------------------------------------------------------------- /ch3/app/proclang/Interp.hs: -------------------------------------------------------------------------------- 1 | module Interp where 2 | 3 | import Expr 4 | import Env 5 | 6 | -- 7 | value_of :: Exp -> Env -> ExpVal 8 | 9 | value_of (Const_Exp n) env = 10 | error "TODO: implement a value_of function" 11 | 12 | value_of (Var_Exp var) env = 13 | error "TODO: implement a value_of function" 14 | 15 | value_of (Diff_Exp exp1 exp2) env = 16 | error "TODO: implement a value_of function" 17 | 18 | value_of (IsZero_Exp exp) env = 19 | error "TODO: implement a value_of function" 20 | 21 | value_of (If_Exp exp1 exp2 exp3) env = 22 | error "TODO: implement a value_of function" 23 | 24 | value_of (Let_Exp var exp1 body) env = 25 | error "TODO: implement a value_of function" 26 | 27 | value_of (Proc_Exp var body) env = 28 | error "TODO: implement a value_of function" 29 | 30 | value_of (Call_Exp rator rand) env = 31 | error "TODO: implement a value_of function" 32 | 33 | 34 | -- 35 | value_of_program :: Exp -> ExpVal 36 | 37 | value_of_program exp = error "TODO: implement a value_of_program function" 38 | 39 | 40 | -- 41 | initEnv :: Env 42 | initEnv = extend_env "i" (Num_Val 1) 43 | (extend_env "v" (Num_Val 5) 44 | (extend_env "x" (Num_Val 10) empty_env)) 45 | 46 | -- 47 | apply_procedure :: Proc -> ExpVal -> ExpVal 48 | apply_procedure proc arg = 49 | error "TODO: implement a apply_procedure function" 50 | -------------------------------------------------------------------------------- /ch3/app/proclang/Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer(lexerSpec) where 2 | 3 | import Prelude hiding (EQ) 4 | import CommonParserUtil 5 | import Token 6 | 7 | mkFn :: Token -> LexAction Token IO () 8 | mkFn tok = \text -> return $ Just tok 9 | 10 | skip :: LexAction Token IO () 11 | skip = \text -> return $ Nothing 12 | 13 | lexerSpec :: LexerSpec Token IO () 14 | lexerSpec = LexerSpec 15 | { 16 | endOfToken = END_OF_TOKEN, 17 | lexerSpecList = 18 | [ ("[ \t\n]" , skip), 19 | 20 | ("[0-9]+" , mkFn INTEGER_NUMBER), 21 | 22 | ("\\-" , mkFn SUB), 23 | ("\\(" , mkFn OPEN_PAREN), 24 | ("\\)" , mkFn CLOSE_PAREN), 25 | ("\\," , mkFn COMMA), 26 | 27 | ("zero\\?" , mkFn ISZERO), 28 | 29 | ("if" , mkFn IF), 30 | ("then" , mkFn THEN), 31 | ("else" , mkFn ELSE), 32 | 33 | ("let" , mkFn LET), 34 | ("in" , mkFn IN), 35 | ("\\=" , mkFn EQ), 36 | 37 | ("proc" , mkFn PROC), 38 | 39 | ("[a-zA-Z][a-zA-Z0-9]*" , mkFn IDENTIFIER) 40 | ] 41 | } 42 | -------------------------------------------------------------------------------- /ch3/app/proclang/Main.lhs: -------------------------------------------------------------------------------- 1 | > module Main where 2 | > 3 | > import CommonParserUtil 4 | 5 | > import TokenInterface 6 | > import Lexer 7 | > import Terminal 8 | > import Parser 9 | > import Expr 10 | > import Interp 11 | 12 | > import Control.Monad (when) 13 | > import System.IO 14 | > import System.Environment (getArgs, withArgs) 15 | > 16 | > main :: IO () 17 | > main = 18 | > do args <- getArgs 19 | > _main args 20 | > 21 | > 22 | > _main [] = return () 23 | > _main (fileName:args) = 24 | > case fileName of 25 | > _ -> do _ <- doProcess True fileName 26 | > _main args 27 | 28 | 29 | > doProcess verbose fileName = do 30 | > text <- readFile fileName 31 | > let debugFlag = False 32 | > 33 | > expression <- 34 | > parsing debugFlag 35 | > parserSpec ((), 1, 1, text) 36 | > (aLexer lexerSpec) 37 | > (fromToken (endOfToken lexerSpec)) 38 | 39 | > putStrLn (show expression) 40 | > 41 | > let val = value_of_program expression 42 | > putStrLn (show val) 43 | 44 | > parser text = do 45 | > parsing False 46 | > parserSpec ((), 1, 1, text) 47 | > (aLexer lexerSpec) 48 | > (fromToken (endOfToken lexerSpec)) 49 | > 50 | > run text = do 51 | > expression <- parser text 52 | > putStrLn (show expression) 53 | > 54 | > let val = value_of_program expression 55 | > putStrLn (show val) 56 | 57 | 58 | 59 | -------------------------------------------------------------------------------- /ch3/app/proclang/MainUtil.hs: -------------------------------------------------------------------------------- 1 | module MainUtil where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | parser text = do 17 | parsing False -- parser converting a text-based program 18 | parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 19 | (aLexer lexerSpec) 20 | (fromToken (endOfToken lexerSpec)) 21 | 22 | run text = do 23 | val <- runProg text True 24 | putStrLn (show val) 25 | 26 | runProg text bool = do 27 | expression <- parser text 28 | 29 | if bool then putStrLn (show expression) else return () 30 | 31 | let val = value_of_program expression -- interpreter 32 | return val 33 | -------------------------------------------------------------------------------- /ch3/app/proclang/Parser.hs: -------------------------------------------------------------------------------- 1 | module Parser where 2 | 3 | import CommonParserUtil 4 | import Token 5 | import Expr 6 | 7 | -- | Utility 8 | rule prodRule action = (prodRule, action, Nothing ) 9 | ruleWithPrec prodRule action prec = (prodRule, action, Just prec) 10 | 11 | -- 12 | parserSpec :: ParserSpec Token Exp IO () 13 | parserSpec = ParserSpec 14 | { 15 | startSymbol = "Expression'", 16 | 17 | tokenPrecAssoc = [], 18 | 19 | parserSpecList = 20 | [ 21 | rule "Expression' -> Expression" (\rhs -> return $ get rhs 1), 22 | 23 | rule "Expression -> integer_number" 24 | (\rhs -> return $ Const_Exp (read (getText rhs 1) :: Int)), 25 | 26 | rule "Expression -> - integer_number" 27 | (\rhs -> return $ Const_Exp (-(read (getText rhs 2) :: Int))), 28 | 29 | rule "Expression -> - ( Expression , Expression )" 30 | (\rhs -> return $ Diff_Exp (get rhs 3) (get rhs 5)), 31 | 32 | rule "Expression -> zero? ( Expression )" 33 | (\rhs -> return $ IsZero_Exp (get rhs 3)), 34 | 35 | rule "Expression -> if Expression then Expression else Expression" 36 | (\rhs -> return $ If_Exp (get rhs 2) (get rhs 4) (get rhs 6)), 37 | 38 | rule "Expression -> identifier" (\rhs -> return $ Var_Exp (getText rhs 1)), 39 | 40 | rule "Expression -> let identifier = Expression in Expression" 41 | (\rhs -> return $ Let_Exp (getText rhs 2) (get rhs 4) (get rhs 6)), 42 | 43 | rule "Expression -> proc ( identifier ) Expression" 44 | (\rhs -> return $ Proc_Exp (getText rhs 3) (get rhs 5)), 45 | 46 | rule "Expression -> ( Expression Expression )" 47 | (\rhs -> return $ Call_Exp (get rhs 2) (get rhs 3)) 48 | ], 49 | 50 | baseDir = "./", 51 | actionTblFile = "action_table_proclang.txt", 52 | gotoTblFile = "goto_table_proclang.txt", 53 | grammarFile = "prod_rules_proclang.txt", 54 | parserSpecFile = "mygrammar_proclang.grm", 55 | genparserexe = "yapb-exe" 56 | } 57 | 58 | 59 | -------------------------------------------------------------------------------- /ch3/app/proclang/ProcLang.lhs: -------------------------------------------------------------------------------- 1 | > module ProcLang where 2 | > 3 | > proclang = "ProcLang" 4 | > 5 | -------------------------------------------------------------------------------- /ch3/app/proclang/Token.hs: -------------------------------------------------------------------------------- 1 | module Token(Token(..)) where 2 | 3 | import Prelude hiding(EQ) 4 | import TokenInterface 5 | 6 | data Token = 7 | END_OF_TOKEN 8 | 9 | | INTEGER_NUMBER -- number 10 | 11 | | SUB -- - ( expr1, expr2 ) 12 | | OPEN_PAREN | CLOSE_PAREN 13 | | COMMA 14 | 15 | | ISZERO -- zero? ( expr ) 16 | 17 | | IF -- if expr1 then expr2 else expr3 18 | | THEN 19 | | ELSE 20 | 21 | | LET -- let identifier = expr1 in expr2 22 | | IN 23 | | EQ 24 | 25 | | PROC -- proc ( identifier ) expr 26 | -- (expr1 expr2) 27 | 28 | | IDENTIFIER -- identifier 29 | deriving (Eq, Show) 30 | 31 | tokenStrList :: [(Token,String)] 32 | tokenStrList = 33 | [ (END_OF_TOKEN, "$"), 34 | 35 | (INTEGER_NUMBER, "integer_number"), 36 | 37 | (SUB, "-"), 38 | (OPEN_PAREN, "("), 39 | (CLOSE_PAREN, ")"), 40 | (COMMA, ","), 41 | 42 | (ISZERO, "zero?"), 43 | 44 | (IF, "if"), 45 | (THEN, "then"), 46 | (ELSE, "else"), 47 | 48 | (IDENTIFIER, "identifier"), 49 | 50 | (LET, "let"), 51 | (IN, "in"), 52 | (EQ, "="), 53 | 54 | (PROC, "proc") 55 | ] 56 | 57 | findTok tok [] = Nothing 58 | findTok tok ((tok_,str):list) 59 | | tok == tok_ = Just str 60 | | otherwise = findTok tok list 61 | 62 | findStr str [] = Nothing 63 | findStr str ((tok,str_):list) 64 | | str == str_ = Just tok 65 | | otherwise = findStr str list 66 | 67 | instance TokenInterface Token where 68 | -- toToken str = 69 | -- case findStr str tokenStrList of 70 | -- Nothing -> error ("toToken: " ++ str) 71 | -- Just tok -> tok 72 | fromToken tok = 73 | case findTok tok tokenStrList of 74 | Nothing -> error ("fromToken: " ++ show tok) 75 | Just str -> str 76 | 77 | 78 | isEOT END_OF_TOKEN = True 79 | isEOT _ = False 80 | -------------------------------------------------------------------------------- /ch3/app/proclang/examples/apply_proc_in_rator_pos.proc: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/apply_simple_proc.proc: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/check_shadowing_in_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = 4 in x -------------------------------------------------------------------------------- /ch3/app/proclang/examples/check_shadowing_in_rhs.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = -(x,1) in x -------------------------------------------------------------------------------- /ch3/app/proclang/examples/eval_let_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in -(x,1) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/eval_let_rhs.let: -------------------------------------------------------------------------------- 1 | let x = -(4,1) in -(x,1) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/if_eval_test_false.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/proclang/examples/if_eval_test_false_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then foo else 4 -------------------------------------------------------------------------------- /ch3/app/proclang/examples/if_eval_test_true.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/proclang/examples/if_eval_test_true_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else foo -------------------------------------------------------------------------------- /ch3/app/proclang/examples/if_false.let: -------------------------------------------------------------------------------- 1 | if zero?(1) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/proclang/examples/if_true.let: -------------------------------------------------------------------------------- 1 | if zero?(0) then 3 else 4 -------------------------------------------------------------------------------- /ch3/app/proclang/examples/let_to_proc_1.proc: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/negative_const.let: -------------------------------------------------------------------------------- 1 | -33 -------------------------------------------------------------------------------- /ch3/app/proclang/examples/nested_arith_left.let: -------------------------------------------------------------------------------- 1 | -(-(44,33),22) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/nested_arith_right.let: -------------------------------------------------------------------------------- 1 | -(55,-(22,11)) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/nested_procs_1.proc: -------------------------------------------------------------------------------- 1 | ((proc (x) proc (y) -(x,y) 5) 6) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/nested_procs_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/no_bool_to_diff_1.let: -------------------------------------------------------------------------------- 1 | -(zero?(0),1) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/no_bool_to_diff_2.let: -------------------------------------------------------------------------------- 1 | -(1,zero?(0)) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/no_int_to_if.let: -------------------------------------------------------------------------------- 1 | if 1 then 2 else 3 2 | -------------------------------------------------------------------------------- /ch3/app/proclang/examples/positive_const.let: -------------------------------------------------------------------------------- 1 | 11 -------------------------------------------------------------------------------- /ch3/app/proclang/examples/simple_arith_1.let: -------------------------------------------------------------------------------- 1 | -(44,33) 2 | -------------------------------------------------------------------------------- /ch3/app/proclang/examples/simple_arith_var_1.let: -------------------------------------------------------------------------------- 1 | -(44,x) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/simple_let_1.let: -------------------------------------------------------------------------------- 1 | let x = 3 in x -------------------------------------------------------------------------------- /ch3/app/proclang/examples/simple_nested_let.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let y = 4 in -(x,y) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/test_unbound_var_1.let: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /ch3/app/proclang/examples/test_unbound_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,foo) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/test_var_1.let: -------------------------------------------------------------------------------- 1 | x -------------------------------------------------------------------------------- /ch3/app/proclang/examples/test_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,1) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/test_var_3.let: -------------------------------------------------------------------------------- 1 | -(1,x) -------------------------------------------------------------------------------- /ch3/app/proclang/examples/y_combinator_1.proc: -------------------------------------------------------------------------------- 1 | let fix = proc (f) 2 | let d = proc (x) proc (z) ((f (x x)) z) 3 | in proc (n) ((f (d d)) n) 4 | in let 5 | t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4) 6 | in let times4 = (fix t4m) 7 | in (times4 3) -------------------------------------------------------------------------------- /ch3/goto_table_letlang.txt: -------------------------------------------------------------------------------- 1 | 0 Expression 1 2 | 5 Expression 11 3 | 9 Expression 13 4 | 10 Expression 14 5 | 15 Expression 19 6 | 16 Expression 20 7 | 17 Expression 21 8 | 22 Expression 25 9 | 23 Expression 26 10 | -------------------------------------------------------------------------------- /ch3/mygrammar_letlang.grm: -------------------------------------------------------------------------------- 1 | (CFG "Expression'" [ 2 | ProductionRule "Expression'" [Nonterminal "Expression"], 3 | ProductionRule "Expression" [Terminal "integer_number"], 4 | ProductionRule "Expression" [Terminal "-", Terminal "integer_number"], 5 | ProductionRule "Expression" [Terminal "-", Terminal "(", Nonterminal "Expression", Terminal ",", Nonterminal "Expression", Terminal ")"], 6 | ProductionRule "Expression" [Terminal "zero?", Terminal "(", Nonterminal "Expression", Terminal ")"], 7 | ProductionRule "Expression" [Terminal "if", Nonterminal "Expression", Terminal "then", Nonterminal "Expression", Terminal "else", Nonterminal "Expression"], 8 | ProductionRule "Expression" [Terminal "identifier"], 9 | ProductionRule "Expression" [Terminal "let", Terminal "identifier", Terminal "=", Nonterminal "Expression", Terminal "in", Nonterminal "Expression"] 10 | ] 11 | , 12 | TokenAttrs [], 13 | ProdRuleAttrs [], 14 | "$") 15 | -------------------------------------------------------------------------------- /ch3/mygrammar_letlang.grm.hash: -------------------------------------------------------------------------------- 1 | -6741655678793052524 -------------------------------------------------------------------------------- /ch3/prod_rules_letlang.txt: -------------------------------------------------------------------------------- 1 | 0: Expression' -> Expression 2 | 1: Expression -> integer_number 3 | 2: Expression -> - integer_number 4 | 3: Expression -> - ( Expression , Expression ) 5 | 4: Expression -> zero? ( Expression ) 6 | 5: Expression -> if Expression then Expression else Expression 7 | 6: Expression -> identifier 8 | 7: Expression -> let identifier = Expression in Expression 9 | -------------------------------------------------------------------------------- /ch3/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) where 4 | 5 | someFunc :: IO () 6 | someFunc = putStrLn "someFunc" 7 | -------------------------------------------------------------------------------- /ch3/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: yapb-0.2.3@sha256:d219b1ff4195682af24ae07b415b119ff164281444f0bcfcac9ed8550c850f40,4744 9 | pantry-tree: 10 | sha256: 1e339417bc7a35c381209900cfbb127259c0228048f63f66c85b65f5dbb670d6 11 | size: 3920 12 | original: 13 | hackage: yapb-0.2.3 14 | snapshots: 15 | - completed: 16 | sha256: cbd5e8593869445794924668479b5bd9f1738d075898623dceacc13b2576b6e3 17 | size: 617355 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/1.yaml 19 | original: 20 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/1.yaml 21 | -------------------------------------------------------------------------------- /ch4/.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ 3 | *.*~ -------------------------------------------------------------------------------- /ch4/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for ch4 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /ch4/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2022 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ch4/README.md: -------------------------------------------------------------------------------- 1 | # ch4 2 | -------------------------------------------------------------------------------- /ch4/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/Env.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} 2 | {-# HLINT ignore "Use camelCase" #-} 3 | {-# HLINT ignore "Eta reduce" #-} 4 | module Env where 5 | 6 | import Ref(Location) 7 | import Expr (Identifier,Exp) 8 | 9 | -- Environment 10 | data Env = 11 | Empty_env 12 | | Extend_env Identifier ExpVal Env 13 | | Extend_env_rec [(Identifier,Identifier,Exp)] Env 14 | 15 | empty_env :: Env 16 | empty_env = Empty_env 17 | 18 | apply_env :: Env -> Identifier -> ExpVal 19 | apply_env Empty_env search_var = error (search_var ++ " is not found.") 20 | apply_env (Extend_env saved_var saved_val saved_env) search_var 21 | | search_var==saved_var = saved_val 22 | | otherwise = apply_env saved_env search_var 23 | apply_env (Extend_env_rec idIdExpList saved_env) search_var 24 | | isIn = mkProcVal 25 | | otherwise = apply_env saved_env search_var 26 | where isIn = or [ p_name==search_var | (p_name,b_var,p_body) <- idIdExpList ] 27 | mkProcVal = head [ Proc_Val (procedure b_var p_body (Extend_env_rec idIdExpList saved_env)) 28 | | (p_name,b_var,p_body) <- idIdExpList, p_name==search_var ] 29 | 30 | extend_env :: Identifier -> ExpVal -> Env -> Env 31 | extend_env x v env = Extend_env x v env 32 | 33 | extend_env_rec :: [(Identifier,Identifier,Exp)] -> Env -> Env 34 | extend_env_rec idIdExpList env = Extend_env_rec idIdExpList env 35 | 36 | -- Expressed values 37 | data ExpVal = 38 | Num_Val {expval_num :: Int} 39 | | Bool_Val {expval_bool :: Bool} 40 | | Proc_Val {expval_proc :: Proc} 41 | | Ref_Val {expval_loc :: Location} 42 | 43 | instance Show ExpVal where 44 | show (Num_Val num) = show num 45 | show (Bool_Val bool) = show bool 46 | show (Proc_Val proc) = show "" 47 | show (Ref_Val loc) = show loc 48 | 49 | -- Denoted values 50 | type DenVal = ExpVal 51 | 52 | -- Procedure values : data structures 53 | data Proc = Procedure {var :: Identifier, body :: Exp, saved_env :: Env} 54 | 55 | procedure :: Identifier -> Exp -> Env -> Proc 56 | procedure var body env = Procedure var body env 57 | 58 | -- In Interp.hs 59 | -- apply_procedure :: Proc -> ExpVal -> ExpVal 60 | 61 | -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/Expr.hs: -------------------------------------------------------------------------------- 1 | module Expr(Program,Exp(..),Identifier,PET(..),fromExp,fromExpList,fromIdIdExpList) where 2 | 3 | type Program = Exp 4 | 5 | data Exp = 6 | Const_Exp Int 7 | | Diff_Exp Exp Exp 8 | | IsZero_Exp Exp 9 | | If_Exp Exp Exp Exp 10 | | Var_Exp Identifier 11 | | Let_Exp Identifier Exp Exp 12 | | Letrec_Exp [(Identifier, Identifier, Exp)] Exp -- letrec f1(x1) = expr1; ... ; fk(xk) = exprk in expr 13 | | Proc_Exp Identifier Exp -- proc 14 | | Call_Exp Exp Exp -- call 15 | | Block_Exp [Exp] 16 | | Newref_Exp Exp 17 | | Deref_Exp Exp 18 | | Setref_Exp Exp Exp 19 | deriving Show 20 | 21 | type Identifier = String 22 | 23 | --- Parsed Expression Tree 24 | 25 | data PET = 26 | PET_IdIdExpList {idIdExpListFrom :: [(Identifier, Identifier, Exp)] } 27 | | PET_ExpList {expListFrom :: [Exp] } 28 | | PET_Exp {expFrom :: Exp} 29 | deriving Show 30 | 31 | fromExp exp = PET_Exp exp 32 | fromExpList expList = PET_ExpList expList 33 | fromIdIdExpList idIdExpList = PET_IdIdExpList idIdExpList 34 | -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/Interp.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} 2 | {-# HLINT ignore "Use camelCase" #-} 3 | {-# OPTIONS_GHC -Wno-incomplete-patterns #-} 4 | module Interp where 5 | 6 | import Expr 7 | import Env 8 | import Store 9 | 10 | -- 11 | value_of :: Exp -> Env -> Store -> (ExpVal, Store) -- Sec 4.2.1: Store-passing specifications 12 | 13 | value_of (Const_Exp n) env store = error "TODO: implement a value_of function" 14 | 15 | value_of (Var_Exp var) env store = error "TODO: implement a value_of function" 16 | 17 | value_of (Diff_Exp exp1 exp2) env store = 18 | error "TODO: implement a value_of function" 19 | 20 | value_of (IsZero_Exp exp) env store = 21 | error "TODO: implement a value_of function" 22 | 23 | value_of (If_Exp exp1 exp2 exp3) env store = 24 | error "TODO: implement a value_of function" 25 | 26 | value_of (Let_Exp var exp1 body) env store = 27 | error "TODO: implement a value_of function" 28 | 29 | value_of (Letrec_Exp letbindings letrec_body) env store = 30 | error "TODO: implement a value_of function" 31 | 32 | value_of (Proc_Exp var body) env store = 33 | error "TODO: implement a value_of function" 34 | 35 | value_of (Call_Exp rator rand) env store = 36 | error "TODO: implement a value_of function" 37 | 38 | value_of (Block_Exp [exp]) env store = 39 | error "TODO: implement a value_of function" 40 | 41 | value_of (Block_Exp (exp:expList)) env store = 42 | error "TODO: implement a value_of function" 43 | 44 | value_of (Newref_Exp exp) env store = 45 | error "TODO: implement a value_of function" 46 | 47 | value_of (Deref_Exp exp) env store = 48 | error "TODO: implement a value_of function" 49 | 50 | value_of (Setref_Exp exp1 exp2) env store = 51 | error "TODO: implement a value_of function" 52 | 53 | -- 54 | value_of_program :: Exp -> ExpVal 55 | 56 | value_of_program exp = 57 | error "TODO: implement a value_of function" 58 | 59 | 60 | -- 61 | initEnv = extend_env "i" (Num_Val 1) 62 | (extend_env "v" (Num_Val 5) 63 | (extend_env "x" (Num_Val 10) empty_env)) 64 | 65 | -- 66 | apply_procedure :: Proc -> ExpVal -> Store -> (ExpVal,Store) 67 | apply_procedure proc arg store = 68 | error "TODO: implement a value_of function" 69 | -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer(lexerSpec) where 2 | 3 | import Prelude hiding (EQ) 4 | import CommonParserUtil 5 | import Token 6 | 7 | mkFn :: Token -> LexAction Token IO () 8 | mkFn tok = \text -> return $ Just tok 9 | 10 | skip :: LexAction Token IO () 11 | skip = \text -> return $ Nothing 12 | 13 | lexerSpec :: LexerSpec Token IO () 14 | lexerSpec = LexerSpec 15 | { 16 | endOfToken = END_OF_TOKEN, 17 | lexerSpecList = 18 | [ ("[ \t\n]" , skip), 19 | 20 | ("[0-9]+" , mkFn INTEGER_NUMBER), 21 | 22 | ("\\-" , mkFn SUB), 23 | ("\\(" , mkFn OPEN_PAREN), 24 | ("\\)" , mkFn CLOSE_PAREN), 25 | ("\\," , mkFn COMMA), 26 | 27 | ("zero\\?" , mkFn ISZERO), 28 | 29 | ("if" , mkFn IF), 30 | ("then" , mkFn THEN), 31 | ("else" , mkFn ELSE), 32 | 33 | ("letrec" , mkFn LETREC), 34 | 35 | ("let" , mkFn LET), 36 | ("in" , mkFn IN), 37 | ("\\=" , mkFn EQ), 38 | 39 | ("proc" , mkFn PROC), 40 | 41 | ("begin" , mkFn BEGIN), 42 | ("end" , mkFn END), 43 | (";" , mkFn SEMICOLON), 44 | 45 | ("newref" , mkFn NEWREF), 46 | ("deref" , mkFn DEREF), 47 | ("setref" , mkFn SETREF), 48 | 49 | 50 | ("[a-zA-Z][a-zA-Z0-9]*" , mkFn IDENTIFIER) 51 | ] 52 | } 53 | -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | main :: IO () 17 | main = 18 | do args <- getArgs 19 | _main args 20 | 21 | 22 | _main [] = return () 23 | _main (fileName:args) = 24 | case fileName of 25 | "test" -> return () 26 | _ -> do _ <- doProcess True fileName 27 | _main args 28 | 29 | 30 | doProcess verbose fileName = do 31 | text <- readFile fileName 32 | let debugFlag = False 33 | 34 | tree <- 35 | parsing debugFlag 36 | parserSpec ((),1,1,text) 37 | (aLexer lexerSpec) 38 | (fromToken (endOfToken lexerSpec)) 39 | 40 | let expression = expFrom tree 41 | 42 | print expression 43 | 44 | let val = value_of_program expression 45 | print val 46 | 47 | parser text = do 48 | parsed_expression <- parsing False 49 | parserSpec ((), 1, 1, text) 50 | (aLexer lexerSpec) 51 | (fromToken (endOfToken lexerSpec)) 52 | let expression = expFrom parsed_expression 53 | return expression 54 | 55 | run text = do 56 | expression <- parser text 57 | putStrLn (show expression) 58 | 59 | let val = value_of_program expression 60 | putStrLn (show val) 61 | -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/MainUtil.hs: -------------------------------------------------------------------------------- 1 | module MainUtil where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | parser text = do 17 | parsing False -- parser converting a text-based program 18 | parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 19 | (aLexer lexerSpec) 20 | (fromToken (endOfToken lexerSpec)) 21 | 22 | run text = do 23 | val <- runProg text True 24 | putStrLn (show val) 25 | 26 | runProg text bool = do 27 | _expression <- parser text 28 | let expression = expFrom _expression 29 | if bool then putStrLn (show expression) else return () 30 | 31 | let val = value_of_program expression -- interpreter 32 | return val 33 | -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/Ref.hs: -------------------------------------------------------------------------------- 1 | module Ref where 2 | 3 | type Location = Integer -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/Store.hs: -------------------------------------------------------------------------------- 1 | module Store where 2 | 3 | import Ref (Location) 4 | import Env (ExpVal) 5 | 6 | 7 | type Store = (Location, [(Location,ExpVal)]) -- Next new location 8 | 9 | newref :: Store -> ExpVal -> (Location,Store) 10 | newref (next,s) v = (next,(next+1,(next,v):s)) 11 | 12 | deref :: Store -> Location -> ExpVal 13 | deref (next,s) loc = 14 | case [v | (loc',v) <- s, loc==loc'] of 15 | (v:_) -> v 16 | _ -> error ("Location not found: " ++ show loc) 17 | 18 | setref :: Store -> Location -> ExpVal -> Store 19 | setref (next,s) loc v = (next,update s) 20 | where update [] = error ("Invalid reference: " ++ show loc) 21 | update ((loc',w):s') 22 | | loc==loc' = (loc,v):s' 23 | | otherwise = (loc',w):update s' 24 | 25 | initStore :: Store 26 | initStore = (1,[]) 27 | -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/assignment_test_1.expref: -------------------------------------------------------------------------------- 1 | let x = newref(17) 2 | in begin setref(x,27); deref(x) end -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/begin_test_1.expref: -------------------------------------------------------------------------------- 1 | begin 1; 2; 3 end -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/chains_1.expref: -------------------------------------------------------------------------------- 1 | let x = newref(newref(0)) 2 | in begin 3 | setref(deref(x), 11); 4 | deref(deref(x)) 5 | end -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/check_shadowing_in_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = 4 in x -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/check_shadowing_in_rhs.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = -(x,1) in x -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/eval_let_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in -(x,1) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/eval_let_rhs.let: -------------------------------------------------------------------------------- 1 | let x = -(4,1) in -(x,1) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/even_odd_via_set_1.expref: -------------------------------------------------------------------------------- 1 | let x = newref(0) 2 | in letrec even(d) = if zero?(deref(x)) 3 | then 1 4 | else let d = setref(x, -(deref(x),1)) 5 | in (odd d) 6 | odd(d) = if zero?(deref(x)) 7 | then 0 8 | else let d = setref(x, -(deref(x),1)) 9 | in (even d) 10 | in let d = setref(x,13) in (odd -100) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/gensym_test_1.expref: -------------------------------------------------------------------------------- 1 | let g = let counter = newref(0) 2 | in proc (dummy) let d = setref(counter, -(deref(counter),-1)) 3 | in deref(counter) 4 | in -((g 11),(g 22)) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/gensym_test_2.expref: -------------------------------------------------------------------------------- 1 | let g = let counter = newref(0) 2 | in proc (dummy) begin 3 | setref(counter, -(deref(counter),-1)); 4 | deref(counter) 5 | end 6 | in -((g 11),(g 22)) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/ho_nested_letrecs.letrec: -------------------------------------------------------------------------------- 1 | letrec even(odd) = proc(x) if zero?(x) then 1 else (odd -(x,1)) 2 | in letrec odd(x) = if zero?(x) then 0 else ((even odd) -(x,1)) 3 | in (odd 13) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/if_eval_test_false.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then 3 else 4 -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/if_eval_test_false_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then foo else 4 -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/if_eval_test_true.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else 4 -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/if_eval_test_true_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else foo -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/if_false.let: -------------------------------------------------------------------------------- 1 | if zero?(1) then 3 else 4 -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/if_true.let: -------------------------------------------------------------------------------- 1 | if zero?(0) then 3 else 4 -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/negative_const.let: -------------------------------------------------------------------------------- 1 | -33 -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/nested_arith_left.let: -------------------------------------------------------------------------------- 1 | -(-(44,33),22) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/nested_arith_right.let: -------------------------------------------------------------------------------- 1 | -(55,-(22,11)) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/nested_procs_1.proc: -------------------------------------------------------------------------------- 1 | ((proc (x) proc (y) -(x,y) 5) 6) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/nested_procs_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/no_bool_to_diff_1.let: -------------------------------------------------------------------------------- 1 | -(zero?(0),1) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/no_bool_to_diff_2.let: -------------------------------------------------------------------------------- 1 | -(1,zero?(0)) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/no_int_to_if.let: -------------------------------------------------------------------------------- 1 | if 1 then 2 else 3 2 | -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/positive_const.let: -------------------------------------------------------------------------------- 1 | 11 -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/show_allocation_1.expref: -------------------------------------------------------------------------------- 1 | let x = newref(22) 2 | in let f = proc (z) let zz = newref(-(z,deref(x))) in deref(zz) 3 | in -((f 66), (f 55)) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/simple_app_1.proc: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/simple_app_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/simple_app_3.proc: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/simple_arith_1.let: -------------------------------------------------------------------------------- 1 | -(44,33) 2 | -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/simple_let_1.let: -------------------------------------------------------------------------------- 1 | let x = 3 in x -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/simple_letrec_1.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = -(x,1) in (f 33) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/simple_letrec_2.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/simple_letrec_3.letrec: -------------------------------------------------------------------------------- 1 | let m = -5 2 | in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/simple_nested_let.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let y = 4 in -(x,y) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/simple_store_test_1.expref: -------------------------------------------------------------------------------- 1 | let x = newref(17) in deref(x) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/test_unbound_var_1.let: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/test_unbound_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,foo) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/test_var_1.let: -------------------------------------------------------------------------------- 1 | x -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/test_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,1) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/test_var_3.let: -------------------------------------------------------------------------------- 1 | -(1,x) -------------------------------------------------------------------------------- /ch4/app/explicitrefslang/examples/y_combinator_1.proc: -------------------------------------------------------------------------------- 1 | let fix = proc (f) 2 | let d = proc (x) proc (z) ((f (x x)) z) 3 | in proc (n) ((f (d d)) n) 4 | in let 5 | t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4) 6 | in let times4 = (fix t4m) 7 | in (times4 3) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/Expr.hs: -------------------------------------------------------------------------------- 1 | module Expr(Program,Exp(..),Identifier,PET(..),fromExp,fromExpList,fromIdIdExpList) where 2 | 3 | type Program = Exp 4 | 5 | data Exp = 6 | Const_Exp Int 7 | | Diff_Exp Exp Exp 8 | | IsZero_Exp Exp 9 | | If_Exp Exp Exp Exp 10 | | Var_Exp Identifier 11 | | Let_Exp Identifier Exp Exp 12 | | Letrec_Exp [(Identifier, Identifier, Exp)] Exp -- letrec f1(x1) = expr1; ... ; fk(xk) = exprk in expr 13 | | Proc_Exp Identifier Exp -- proc 14 | | Call_Exp Exp Exp -- call 15 | | Block_Exp [Exp] 16 | | Set_Exp Identifier Exp 17 | deriving Show 18 | 19 | type Identifier = String 20 | 21 | --- Parsed Expression Tree 22 | 23 | data PET = 24 | PET_IdIdExpList {idIdExpListFrom :: [(Identifier, Identifier, Exp)] } 25 | | PET_ExpList {expListFrom :: [Exp] } 26 | | PET_Exp {expFrom :: Exp} 27 | deriving Show 28 | 29 | fromExp exp = PET_Exp exp 30 | fromExpList expList = PET_ExpList expList 31 | fromIdIdExpList idIdExpList = PET_IdIdExpList idIdExpList 32 | -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/Interp.hs: -------------------------------------------------------------------------------- 1 | module Interp where 2 | 3 | import Expr 4 | import EnvStore 5 | 6 | -- 7 | value_of :: Exp -> Env -> Store -> (ExpVal, Store) -- Sec 4.2.1: Store-passing specifications 8 | 9 | value_of (Const_Exp n) env store = 10 | error "TODO: implement a value_of function" 11 | 12 | value_of (Var_Exp var) env store = 13 | error "TODO: implement a value_of function" 14 | 15 | value_of (Diff_Exp exp1 exp2) env store = 16 | error "TODO: implement a value_of function" 17 | 18 | value_of (IsZero_Exp exp) env store = 19 | error "TODO: implement a value_of function" 20 | 21 | value_of (If_Exp exp1 exp2 exp3) env store = 22 | error "TODO: implement a value_of function" 23 | 24 | value_of (Let_Exp var exp1 body) env store = 25 | error "TODO: implement a value_of function" 26 | 27 | value_of (Letrec_Exp letbindings letrec_body) env store = 28 | error "TODO: implement a value_of function" 29 | 30 | value_of (Proc_Exp var body) env store = 31 | error "TODO: implement a value_of function" 32 | 33 | value_of (Call_Exp rator rand) env store = 34 | error "TODO: implement a value_of function" 35 | 36 | value_of (Block_Exp [exp]) env store = 37 | error "TODO: implement a value_of function" 38 | 39 | value_of (Block_Exp (exp:expList)) env store = 40 | error "TODO: implement a value_of function" 41 | 42 | value_of (Set_Exp x exp) env store = 43 | error "TODO: implement a value_of function" 44 | 45 | -- 46 | value_of_program :: Exp -> ExpVal 47 | 48 | value_of_program exp = 49 | error "TODO: implement a value_of_program function" 50 | 51 | 52 | -- 53 | initEnv = empty_env 54 | 55 | -- 56 | apply_procedure :: Proc -> ExpVal -> Store -> (ExpVal,Store) 57 | apply_procedure proc arg store = 58 | error "TODO: implement an apply_procedure function" 59 | -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer(lexerSpec) where 2 | 3 | import Prelude hiding (EQ) 4 | import CommonParserUtil 5 | import Token 6 | 7 | mkFn :: Token -> LexAction Token IO () 8 | mkFn tok = \text -> return $ Just tok 9 | 10 | skip :: LexAction Token IO () 11 | skip = \text -> return $ Nothing 12 | 13 | lexerSpec :: LexerSpec Token IO () 14 | lexerSpec = LexerSpec 15 | { 16 | endOfToken = END_OF_TOKEN, 17 | lexerSpecList = 18 | [ ("[ \t\n]" , skip), 19 | 20 | ("[0-9]+" , mkFn INTEGER_NUMBER), 21 | 22 | ("\\-" , mkFn SUB), 23 | ("\\(" , mkFn OPEN_PAREN), 24 | ("\\)" , mkFn CLOSE_PAREN), 25 | ("\\," , mkFn COMMA), 26 | 27 | ("zero\\?" , mkFn ISZERO), 28 | 29 | ("if" , mkFn IF), 30 | ("then" , mkFn THEN), 31 | ("else" , mkFn ELSE), 32 | 33 | ("letrec" , mkFn LETREC), 34 | 35 | ("let" , mkFn LET), 36 | ("in" , mkFn IN), 37 | ("\\=" , mkFn EQ), 38 | 39 | ("proc" , mkFn PROC), 40 | 41 | ("begin" , mkFn BEGIN), 42 | ("end" , mkFn END), 43 | (";" , mkFn SEMICOLON), 44 | 45 | ("set" , mkFn SET), 46 | 47 | 48 | ("[a-zA-Z][a-zA-Z0-9]*" , mkFn IDENTIFIER) 49 | ] 50 | } 51 | -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | main :: IO () 17 | main = 18 | do args <- getArgs 19 | _main args 20 | 21 | 22 | _main [] = return () 23 | _main (fileName:args) = 24 | case fileName of 25 | "test" -> return () 26 | _ -> do _ <- doProcess True fileName 27 | _main args 28 | 29 | 30 | doProcess verbose fileName = do 31 | text <- readFile fileName 32 | let debugFlag = False 33 | 34 | tree <- 35 | parsing debugFlag 36 | parserSpec ((),1,1,text) 37 | (aLexer lexerSpec) 38 | (fromToken (endOfToken lexerSpec)) 39 | 40 | let expression = expFrom tree 41 | 42 | print expression 43 | 44 | let val = value_of_program expression 45 | print val 46 | 47 | parser text = do 48 | parsed_expression <- parsing False 49 | parserSpec ((), 1, 1, text) 50 | (aLexer lexerSpec) 51 | (fromToken (endOfToken lexerSpec)) 52 | let expression = expFrom parsed_expression 53 | return expression 54 | 55 | run text = do 56 | expression <- parser text 57 | putStrLn (show expression) 58 | 59 | let val = value_of_program expression 60 | putStrLn (show val) 61 | -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/MainUtil.hs: -------------------------------------------------------------------------------- 1 | module MainUtil where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | parser text = do 17 | parsing False -- parser converting a text-based program 18 | parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 19 | (aLexer lexerSpec) 20 | (fromToken (endOfToken lexerSpec)) 21 | 22 | run text = do 23 | val <- runProg text True 24 | putStrLn (show val) 25 | 26 | runProg text bool = do 27 | _expression <- parser text 28 | let expression = expFrom _expression 29 | 30 | if bool then putStrLn (show expression) else return () 31 | 32 | let val = value_of_program expression -- interpreter 33 | return val 34 | -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/Ref.hs: -------------------------------------------------------------------------------- 1 | module Ref where 2 | 3 | type Location = Integer -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/apply_proc_in_rator_pos.proc: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/apply_simple_proc.proc: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/assignment_test_1.impref: -------------------------------------------------------------------------------- 1 | let x = 17 2 | in begin set x = 27; x end -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/begin_test_1.letrec_ext: -------------------------------------------------------------------------------- 1 | begin 1; 2; 3 end -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/check_shadowing_in_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = 4 in x -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/check_shadowing_in_rhs.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = -(x,1) in x -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/eval_let_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in -(x,1) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/eval_let_rhs.let: -------------------------------------------------------------------------------- 1 | let x = -(4,1) in -(x,1) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/even_odd_via_set_1.impref: -------------------------------------------------------------------------------- 1 | let x = 0 2 | in letrec even(d) = if zero?(x) then 1 3 | else let d = set x = -(x,1) 4 | in (odd d) 5 | odd(d) = if zero?(x) then 0 6 | else let d = set x = -(x,1) 7 | in (even d) 8 | in let d = set x = 13 in (odd -99) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/example_for_book_1.impref: -------------------------------------------------------------------------------- 1 | let f = proc (x) proc (y) 2 | begin 3 | set x = -(x,-1); 4 | -(x,y) 5 | end 6 | in ((f 44) 33) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/gensym_test_1.impref: -------------------------------------------------------------------------------- 1 | let g = let count = 0 in proc(d) 2 | let d = set count = -(count,-1) 3 | in count 4 | in -((g 11), (g 22)) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/ho_nested_letrecs.letrec: -------------------------------------------------------------------------------- 1 | letrec even(odd) = proc(x) if zero?(x) then 1 else (odd -(x,1)) 2 | in letrec odd(x) = if zero?(x) then 0 else ((even odd) -(x,1)) 3 | in (odd 13) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/if_eval_test_false.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then 3 else 4 -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/if_eval_test_false_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then foo else 4 -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/if_eval_test_true.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else 4 -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/if_eval_test_true_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else foo -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/if_false.let: -------------------------------------------------------------------------------- 1 | if zero?(1) then 3 else 4 -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/if_true.let: -------------------------------------------------------------------------------- 1 | if zero?(0) then 3 else 4 -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/let_to_proc_1.proc: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/negative_const.let: -------------------------------------------------------------------------------- 1 | -33 -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/nested_arith_left.let: -------------------------------------------------------------------------------- 1 | -(-(44,33),22) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/nested_arith_right.let: -------------------------------------------------------------------------------- 1 | -(55,-(22,11)) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/nested_procs_1.proc: -------------------------------------------------------------------------------- 1 | ((proc (x) proc (y) -(x,y) 5) 6) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/nested_procs_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/no_bool_to_diff_1.let: -------------------------------------------------------------------------------- 1 | -(zero?(0),1) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/no_bool_to_diff_2.let: -------------------------------------------------------------------------------- 1 | -(1,zero?(0)) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/no_int_to_if.let: -------------------------------------------------------------------------------- 1 | if 1 then 2 else 3 2 | -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/positive_const.let: -------------------------------------------------------------------------------- 1 | 11 -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/simple_app_1.proc: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/simple_app_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/simple_app_3.proc: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/simple_arith_1.let: -------------------------------------------------------------------------------- 1 | -(44,33) 2 | -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/simple_let_1.let: -------------------------------------------------------------------------------- 1 | let x = 3 in x -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/simple_letrec_1.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = -(x,1) in (f 33) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/simple_letrec_2.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/simple_letrec_3.letrec: -------------------------------------------------------------------------------- 1 | let m = -5 2 | in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/simple_nested_let.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let y = 4 in -(x,y) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/test_unbound_var_1.let: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/test_unbound_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,foo) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/test_var_1.let: -------------------------------------------------------------------------------- 1 | x -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/test_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,1) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/test_var_3.let: -------------------------------------------------------------------------------- 1 | -(1,x) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/examples/y_combinator_1.proc: -------------------------------------------------------------------------------- 1 | let fix = proc (f) 2 | let d = proc (x) proc (z) ((f (x x)) z) 3 | in proc (n) ((f (d d)) n) 4 | in let 5 | t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4) 6 | in let times4 = (fix t4m) 7 | in (times4 3) -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/goto_table_implicitrefslang.txt: -------------------------------------------------------------------------------- 1 | 0 Expression 1 2 | 4 Expression 15 3 | 6 Expression 17 4 | 9 LetRecBindings 19 5 | 11 ExpressionList 23 6 | 11 Expression 22 7 | 14 Expression 25 8 | 15 Expression 26 9 | 16 Expression 27 10 | 28 Expression 39 11 | 29 Expression 40 12 | 30 Expression 41 13 | 33 ExpressionList 44 14 | 33 Expression 22 15 | 35 Expression 45 16 | 36 Expression 46 17 | 43 Expression 50 18 | 47 Expression 52 19 | 48 Expression 53 20 | 54 Expression 55 21 | 55 LetRecBindings 56 22 | -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/mygrammar_implicitrefslang.grm: -------------------------------------------------------------------------------- 1 | (CFG "Expression'" [ 2 | ProductionRule "Expression'" [Nonterminal "Expression"], 3 | ProductionRule "Expression" [Terminal "integer_number"], 4 | ProductionRule "Expression" [Terminal "-", Terminal "integer_number"], 5 | ProductionRule "Expression" [Terminal "-", Terminal "(", Nonterminal "Expression", Terminal ",", Nonterminal "Expression", Terminal ")"], 6 | ProductionRule "Expression" [Terminal "zero?", Terminal "(", Nonterminal "Expression", Terminal ")"], 7 | ProductionRule "Expression" [Terminal "if", Nonterminal "Expression", Terminal "then", Nonterminal "Expression", Terminal "else", Nonterminal "Expression"], 8 | ProductionRule "Expression" [Terminal "identifier"], 9 | ProductionRule "Expression" [Terminal "let", Terminal "identifier", Terminal "=", Nonterminal "Expression", Terminal "in", Nonterminal "Expression"], 10 | ProductionRule "Expression" [Terminal "letrec", Nonterminal "LetRecBindings", Terminal "in", Nonterminal "Expression"], 11 | ProductionRule "Expression" [Terminal "proc", Terminal "(", Terminal "identifier", Terminal ")", Nonterminal "Expression"], 12 | ProductionRule "Expression" [Terminal "(", Nonterminal "Expression", Nonterminal "Expression", Terminal ")"], 13 | ProductionRule "Expression" [Terminal "begin", Nonterminal "ExpressionList", Terminal "end"], 14 | ProductionRule "Expression" [Terminal "set", Terminal "identifier", Terminal "=", Nonterminal "Expression"], 15 | ProductionRule "LetRecBindings" [Terminal "identifier", Terminal "(", Terminal "identifier", Terminal ")", Terminal "=", Nonterminal "Expression"], 16 | ProductionRule "LetRecBindings" [Terminal "identifier", Terminal "(", Terminal "identifier", Terminal ")", Terminal "=", Nonterminal "Expression", Nonterminal "LetRecBindings"], 17 | ProductionRule "ExpressionList" [Nonterminal "Expression"], 18 | ProductionRule "ExpressionList" [Nonterminal "Expression", Terminal ";", Nonterminal "ExpressionList"] 19 | ] 20 | , 21 | TokenAttrs [], 22 | ProdRuleAttrs [], 23 | "$") 24 | -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/mygrammar_implicitrefslang.grm.hash: -------------------------------------------------------------------------------- 1 | -1075125655037129308 -------------------------------------------------------------------------------- /ch4/app/implicitrefslang/prod_rules_implicitrefslang.txt: -------------------------------------------------------------------------------- 1 | 0: Expression' -> Expression 2 | 1: Expression -> integer_number 3 | 2: Expression -> - integer_number 4 | 3: Expression -> - ( Expression , Expression ) 5 | 4: Expression -> zero? ( Expression ) 6 | 5: Expression -> if Expression then Expression else Expression 7 | 6: Expression -> identifier 8 | 7: Expression -> let identifier = Expression in Expression 9 | 8: Expression -> letrec LetRecBindings in Expression 10 | 9: Expression -> proc ( identifier ) Expression 11 | 10: Expression -> ( Expression Expression ) 12 | 11: Expression -> begin ExpressionList end 13 | 12: Expression -> set identifier = Expression 14 | 13: LetRecBindings -> identifier ( identifier ) = Expression 15 | 14: LetRecBindings -> identifier ( identifier ) = Expression LetRecBindings 16 | 15: ExpressionList -> Expression 17 | 16: ExpressionList -> Expression ; ExpressionList 18 | -------------------------------------------------------------------------------- /ch4/package.yaml: -------------------------------------------------------------------------------- 1 | name: ch4 2 | version: 0.1.0.0 3 | github: "githubuser/ch4" 4 | license: BSD3 5 | author: "Author name here" 6 | maintainer: "example@example.com" 7 | copyright: "2022 Author name here" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - yapb >= 0.2.3 25 | - hspec 26 | 27 | library: 28 | source-dirs: src 29 | 30 | executables: 31 | expref-exe: 32 | main: Main.hs 33 | source-dirs: app/explicitrefslang 34 | ghc-options: 35 | - -threaded 36 | - -rtsopts 37 | - -with-rtsopts=-N 38 | dependencies: 39 | - ch4 40 | 41 | impref-exe: 42 | main: Main.hs 43 | source-dirs: app/implicitrefslang 44 | ghc-options: 45 | - -threaded 46 | - -rtsopts 47 | - -with-rtsopts=-N 48 | dependencies: 49 | - ch4 50 | 51 | tests: 52 | explicitrefslang-test: 53 | main: Spec.hs 54 | source-dirs: 55 | - test/explicitrefslang 56 | - app/explicitrefslang 57 | ghc-options: 58 | - -threaded 59 | - -rtsopts 60 | - -with-rtsopts=-N 61 | dependencies: 62 | - ch4 63 | 64 | implicitrefslang-test: 65 | main: Spec.hs 66 | source-dirs: 67 | - test/implicitrefslang 68 | - app/implicitrefslang 69 | ghc-options: 70 | - -threaded 71 | - -rtsopts 72 | - -with-rtsopts=-N 73 | dependencies: 74 | - ch4 75 | -------------------------------------------------------------------------------- /ch4/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) where 4 | 5 | someFunc :: IO () 6 | someFunc = putStrLn "someFunc" 7 | -------------------------------------------------------------------------------- /ch4/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: yapb-0.2.3@sha256:d219b1ff4195682af24ae07b415b119ff164281444f0bcfcac9ed8550c850f40,4744 9 | pantry-tree: 10 | size: 3920 11 | sha256: 1e339417bc7a35c381209900cfbb127259c0228048f63f66c85b65f5dbb670d6 12 | original: 13 | hackage: yapb-0.2.3 14 | snapshots: 15 | - completed: 16 | size: 617368 17 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/2.yaml 18 | sha256: e7e57649a12f6178d1158e4b6f1f1885ed56d210ae6174385271cecc9b1ea974 19 | original: 20 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/2.yaml 21 | -------------------------------------------------------------------------------- /ch5/.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ -------------------------------------------------------------------------------- /ch5/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for ch5 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /ch5/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2022 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ch5/README.md: -------------------------------------------------------------------------------- 1 | # ch5 2 | -------------------------------------------------------------------------------- /ch5/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ch5/app/exceptions/Env.hs: -------------------------------------------------------------------------------- 1 | module Env where 2 | 3 | import Expr (Identifier,Exp) 4 | import Data.List(intersperse) 5 | 6 | -- Environment 7 | data Env = 8 | Empty_env 9 | | Extend_env Identifier ExpVal Env 10 | | Extend_env_rec Identifier Identifier Exp Env 11 | 12 | empty_env :: Env 13 | empty_env = Empty_env 14 | 15 | apply_env :: Env -> Identifier -> ExpVal 16 | apply_env Empty_env search_var = error (search_var ++ " is not found.") 17 | apply_env (Extend_env saved_var saved_val saved_env) search_var 18 | | search_var==saved_var = saved_val 19 | | otherwise = apply_env saved_env search_var 20 | apply_env (Extend_env_rec p_name b_var p_body saved_env) search_var 21 | | p_name==search_var = Proc_Val (procedure b_var p_body (Extend_env_rec p_name b_var p_body saved_env)) 22 | | otherwise = apply_env saved_env search_var 23 | 24 | extend_env :: Identifier -> ExpVal -> Env -> Env 25 | extend_env x v env = Extend_env x v env 26 | 27 | extend_env_rec :: Identifier -> Identifier -> Exp -> Env -> Env 28 | extend_env_rec f x exp env = Extend_env_rec f x exp env 29 | 30 | -- Expressed values 31 | data ExpVal = 32 | Num_Val {expval_num :: Int} 33 | | Bool_Val {expval_bool :: Bool} 34 | | Proc_Val {expval_proc :: Proc} 35 | | List_Val {expval_list :: [ExpVal]} 36 | 37 | instance Show ExpVal where 38 | show (Num_Val num) = show num 39 | show (Bool_Val bool) = show bool 40 | show (Proc_Val proc) = show "" 41 | show (List_Val nums) = show "[" ++ concat (intersperse "," (map show nums)) ++ show "]" 42 | 43 | -- Denoted values 44 | type DenVal = ExpVal 45 | 46 | -- Procedure values : data structures 47 | data Proc = Procedure {var :: Identifier, body :: Exp, saved_env :: Env} 48 | 49 | procedure :: Identifier -> Exp -> Env -> Proc 50 | procedure var body env = Procedure var body env 51 | 52 | -- In Interp.hs 53 | -- apply_procedure :: Proc -> ExpVal -> ExpVal 54 | 55 | -------------------------------------------------------------------------------- /ch5/app/exceptions/Expr.hs: -------------------------------------------------------------------------------- 1 | module Expr(Program,Exp(..),Identifier,UnaryOp(..)) where 2 | 3 | type Program = Exp 4 | 5 | data Exp = 6 | Const_Exp Int 7 | | Diff_Exp Exp Exp 8 | | If_Exp Exp Exp Exp 9 | | Var_Exp Identifier 10 | | Let_Exp Identifier Exp Exp 11 | | Letrec_Exp Identifier Identifier Exp Exp -- letrec f(x) = ... recusive expr ... 12 | | Proc_Exp Identifier Exp -- proc 13 | | Call_Exp Exp Exp -- call 14 | | Const_List_Exp [Int] -- number list 15 | | Unary_Exp UnaryOp Exp -- null?, car, cdr 16 | | Try_Exp Exp Identifier Exp -- try exp catch exn exp 17 | | Raise_Exp Exp -- raise exp 18 | deriving Show 19 | 20 | data UnaryOp = IsZero | IsNull | Car | Cdr deriving Show 21 | 22 | type Identifier = String 23 | 24 | -------------------------------------------------------------------------------- /ch5/app/exceptions/Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer(lexerSpec) where 2 | 3 | import Prelude hiding (EQ) 4 | import CommonParserUtil 5 | import Token 6 | 7 | mkFn :: Token -> LexAction Token IO () 8 | mkFn tok = \text -> return $ Just tok 9 | 10 | skip :: LexAction Token IO () 11 | skip = \text -> return $ Nothing 12 | 13 | lexerSpec :: LexerSpec Token IO () 14 | lexerSpec = LexerSpec 15 | { 16 | endOfToken = END_OF_TOKEN, 17 | lexerSpecList = 18 | [ ("[ \t\n]" , skip), 19 | 20 | ("[0-9]+" , mkFn INTEGER_NUMBER), 21 | 22 | ("\\-" , mkFn SUB), 23 | ("\\(" , mkFn OPEN_PAREN), 24 | ("\\)" , mkFn CLOSE_PAREN), 25 | ("\\," , mkFn COMMA), 26 | 27 | ("zero\\?" , mkFn ISZERO), 28 | 29 | ("if" , mkFn IF), 30 | ("then" , mkFn THEN), 31 | ("else" , mkFn ELSE), 32 | 33 | ("letrec" , mkFn LETREC), 34 | 35 | ("let" , mkFn LET), 36 | ("\\=" , mkFn EQ), 37 | 38 | ("proc" , mkFn PROC), 39 | 40 | ("list" , mkFn LIST), 41 | ("null\\?" , mkFn ISNULL), 42 | ("car" , mkFn CAR), 43 | ("cdr" , mkFn CDR), 44 | 45 | ("try" , mkFn TRY), 46 | ("catch" , mkFn CATCH), 47 | ("raise" , mkFn RAISE), 48 | 49 | ("in[ \t\n]" , mkFn IN), 50 | 51 | ("[a-zA-Z][a-zA-Z0-9]*" , mkFn IDENTIFIER) 52 | ] 53 | } 54 | -------------------------------------------------------------------------------- /ch5/app/exceptions/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | main :: IO () 17 | main = 18 | do args <- getArgs 19 | _main args 20 | 21 | 22 | _main [] = return () 23 | _main (fileName:args) = 24 | case fileName of 25 | _ -> do _ <- doProcess True fileName 26 | _main args 27 | 28 | 29 | doProcess verbose fileName = do 30 | putStrLn fileName 31 | text <- readFile fileName 32 | let debugFlag = False 33 | 34 | expression <- 35 | parsing debugFlag 36 | parserSpec ((), 1, 1, text) 37 | (aLexer lexerSpec) 38 | (fromToken (endOfToken lexerSpec)) 39 | 40 | putStrLn (show expression) 41 | 42 | let val = value_of_program expression 43 | putStrLn (show val) 44 | 45 | -------------------------------------------------------------------------------- /ch5/app/exceptions/MainUtil.hs: -------------------------------------------------------------------------------- 1 | module MainUtil where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | parser text = do 17 | parsing False -- parser converting a text-based program 18 | parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 19 | (aLexer lexerSpec) 20 | (fromToken (endOfToken lexerSpec)) 21 | 22 | run text = do 23 | val <- runProg text True 24 | putStrLn (show val) 25 | 26 | runProg text bool = do 27 | expression <- parser text 28 | 29 | if bool then putStrLn (show expression) else return () 30 | 31 | let val = value_of_program expression -- interpreter 32 | return val 33 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/apply_proc_in_rator_pos.proc: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/apply_simple_proc.proc: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/car_1.exn: -------------------------------------------------------------------------------- 1 | car(list(2,3,4)) 2 | 3 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/cdr_1.exn: -------------------------------------------------------------------------------- 1 | cdr(list(2,3,4)) 2 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/check_shadowing_in_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = 4 in x -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/check_shadowing_in_rhs.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = -(x,1) in x -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/dont_run_handler_til_failure.exn: -------------------------------------------------------------------------------- 1 | try 33 2 | catch (m) foo -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/eval_let_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in -(x,1) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/eval_let_rhs.let: -------------------------------------------------------------------------------- 1 | let x = -(4,1) in -(x,1) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/exceptions_have_dynamic_scope_1.exn: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x, -(raise 99, 1)) 2 | in try (f 33) 3 | catch (m) 44 4 | 5 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/handler_in_non_tail_recursive_position.exn: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x, -(raise 99, 1)) 2 | in -(try (f 33) 3 | catch (m) -(m,55), 4 | 1) 5 | 6 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/ho_nested_letrecs.letrec: -------------------------------------------------------------------------------- 1 | letrec even(odd) = proc(x) if zero?(x) then 1 else (odd -(x,1)) 2 | in letrec odd(x) = if zero?(x) then 0 else ((even odd) -(x,1)) 3 | in (odd 13) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/if_eval_test_false.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/if_eval_test_false_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then foo else 4 -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/if_eval_test_true.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/if_eval_test_true_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else foo -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/if_false.let: -------------------------------------------------------------------------------- 1 | if zero?(1) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/if_true.let: -------------------------------------------------------------------------------- 1 | if zero?(0) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/let_to_proc_1.proc: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/lists_1.exn: -------------------------------------------------------------------------------- 1 | list(2, 3, 4) 2 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/negative_const.let: -------------------------------------------------------------------------------- 1 | -33 -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/nested_arith_left.let: -------------------------------------------------------------------------------- 1 | -(-(44,33),22) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/nested_arith_right.let: -------------------------------------------------------------------------------- 1 | -(55,-(22,11)) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/nested_procs_1.proc: -------------------------------------------------------------------------------- 1 | ((proc (x) proc (y) -(x,y) 5) 6) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/nested_procs_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/no_bool_to_diff_1.let: -------------------------------------------------------------------------------- 1 | -(zero?(0),1) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/no_bool_to_diff_2.let: -------------------------------------------------------------------------------- 1 | -(1,zero?(0)) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/no_int_to_if.let: -------------------------------------------------------------------------------- 1 | if 1 then 2 else 3 2 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/positive_const.let: -------------------------------------------------------------------------------- 1 | 11 -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/propagate_error_1.exn: -------------------------------------------------------------------------------- 1 | try try -(raise 23, 11) 2 | catch (m) -(raise 22,1) 3 | catch (m) m 4 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/propagate_error_2.exn: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(1, raise 99) 2 | in 3 | try 4 | try (f 44) 5 | catch (exc) (f 23) 6 | catch (exc) 11 7 | 8 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_app_1.proc: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_app_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_app_3.proc: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_arith_1.let: -------------------------------------------------------------------------------- 1 | -(44,33) 2 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_failure.exn: -------------------------------------------------------------------------------- 1 | try -(1, raise 44) catch (m) m 2 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_let_1.let: -------------------------------------------------------------------------------- 1 | let x = 3 in x -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_letrec_1.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = -(x,1) in (f 33) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_letrec_2.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_letrec_3.letrec: -------------------------------------------------------------------------------- 1 | let m = -5 2 | in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_nested_let.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let y = 4 in -(x,y) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/simple_succeed.exn: -------------------------------------------------------------------------------- 1 | try 33 2 | catch (m) 44 3 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/test_unbound_var_1.let: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/test_unbound_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,foo) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/test_var_1.let: -------------------------------------------------------------------------------- 1 | x -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/test_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,1) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/test_var_3.let: -------------------------------------------------------------------------------- 1 | -(1,x) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/text_example_0_1.exn: -------------------------------------------------------------------------------- 1 | let index 2 | = proc (n) 3 | letrec inner2 (lst) 4 | = if null?(lst) then lst 5 | else if zero?(-(car(lst),n)) then lst 6 | else let v = (inner2 cdr(lst)) 7 | in v 8 | in proc (lst) 9 | try (inner2 lst) 10 | catch (x) -1 11 | in ((index 3) list(2, 3, 4)) 12 | 13 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/text_example_0_2.exn: -------------------------------------------------------------------------------- 1 | let index 2 | = proc (n) 3 | letrec inner2 (lst) 4 | = if null?(lst) then lst 5 | else if zero?(-(car(lst),n)) then lst 6 | else let v = (inner2 cdr(lst)) 7 | in v 8 | in proc (lst) 9 | try (inner2 lst) 10 | catch (x) -1 11 | in ((index 3) list(2, 3, 4)) 12 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/text_example_1_1.exn: -------------------------------------------------------------------------------- 1 | let index 2 | = proc (n) 3 | letrec inner2 (lst) 4 | = if null?(lst) then raise 99 5 | else if zero?(-(car(lst),n)) then 0 6 | else let v = (inner2 cdr(lst)) 7 | in -(v,-1) 8 | in proc (lst) 9 | try (inner2 lst) 10 | catch (x) -1 11 | in ((index 2) list(2, 3, 4)) 12 | 13 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/text_example_1_2.exn: -------------------------------------------------------------------------------- 1 | let index 2 | = proc (n) 3 | letrec inner2 (lst) 4 | = if null?(lst) then raise 99 5 | else if zero?(-(car(lst),n)) then 0 6 | else -((inner2 cdr(lst)), -1) 7 | in proc (lst) 8 | try (inner2 lst) 9 | catch (x) -1 10 | in ((index 5) list(2, 3)) 11 | 12 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/twice.letrec: -------------------------------------------------------------------------------- 1 | (proc (twice) 2 | ((twice proc (z) -(z,1)) 11) 3 | proc (f) proc (x) (f (f x))) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/twice.proc: -------------------------------------------------------------------------------- 1 | (proc (twice) 2 | ((twice proc (z) -(z,1)) 11) 3 | proc (f) proc (x) (f (f x))) -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/uncaught_exception.exn: -------------------------------------------------------------------------------- 1 | -(22, raise 13) 2 | -------------------------------------------------------------------------------- /ch5/app/exceptions/examples/y_combinator_1.proc: -------------------------------------------------------------------------------- 1 | let fix = proc (f) 2 | let d = proc (x) proc (z) ((f (x x)) z) 3 | in proc (n) ((f (d d)) n) 4 | in let 5 | t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4) 6 | in let times4 = (fix t4m) 7 | in (times4 3) -------------------------------------------------------------------------------- /ch5/app/exceptions/exceptions.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.34.4. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: exceptions 8 | version: 0.1.0.0 9 | description: Please see the README on GitHub at 10 | homepage: https://github.com/githubuser/exceptions#readme 11 | bug-reports: https://github.com/githubuser/exceptions/issues 12 | author: Author name here 13 | maintainer: example@example.com 14 | copyright: 2022 Author name here 15 | license: BSD3 16 | license-file: LICENSE 17 | build-type: Simple 18 | extra-source-files: 19 | README.md 20 | ChangeLog.md 21 | 22 | source-repository head 23 | type: git 24 | location: https://github.com/githubuser/exceptions 25 | 26 | library 27 | exposed-modules: 28 | Lib 29 | other-modules: 30 | Paths_exceptions 31 | hs-source-dirs: 32 | src 33 | build-depends: 34 | base >=4.7 && <5 35 | default-language: Haskell2010 36 | 37 | executable exceptions-exe 38 | main-is: Main.hs 39 | other-modules: 40 | Env 41 | Expr 42 | Interp 43 | Lexer 44 | Parser 45 | Setup 46 | Token 47 | Paths_exceptions 48 | hs-source-dirs: 49 | app 50 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 51 | build-depends: 52 | base >=4.7 && <5 53 | , exceptions 54 | default-language: Haskell2010 55 | 56 | test-suite exceptions-test 57 | type: exitcode-stdio-1.0 58 | main-is: Spec.hs 59 | other-modules: 60 | Paths_exceptions 61 | hs-source-dirs: 62 | test 63 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 64 | build-depends: 65 | base >=4.7 && <5 66 | , exceptions 67 | default-language: Haskell2010 68 | -------------------------------------------------------------------------------- /ch5/app/letreccps/Env.hs: -------------------------------------------------------------------------------- 1 | module Env where 2 | 3 | import Expr (Identifier,Exp) 4 | 5 | -- Environment 6 | data Env = 7 | Empty_env 8 | | Extend_env Identifier ExpVal Env 9 | | Extend_env_rec Identifier Identifier Exp Env 10 | 11 | empty_env :: Env 12 | empty_env = Empty_env 13 | 14 | apply_env :: Env -> Identifier -> ExpVal 15 | apply_env Empty_env search_var = error (search_var ++ " is not found.") 16 | apply_env (Extend_env saved_var saved_val saved_env) search_var 17 | | search_var==saved_var = saved_val 18 | | otherwise = apply_env saved_env search_var 19 | apply_env (Extend_env_rec p_name b_var p_body saved_env) search_var 20 | | p_name==search_var = Proc_Val (procedure b_var p_body (Extend_env_rec p_name b_var p_body saved_env)) 21 | | otherwise = apply_env saved_env search_var 22 | 23 | extend_env :: Identifier -> ExpVal -> Env -> Env 24 | extend_env x v env = Extend_env x v env 25 | 26 | extend_env_rec :: Identifier -> Identifier -> Exp -> Env -> Env 27 | extend_env_rec f x exp env = Extend_env_rec f x exp env 28 | 29 | -- Expressed values 30 | data ExpVal = 31 | Num_Val {expval_num :: Int} 32 | | Bool_Val {expval_bool :: Bool} 33 | | Proc_Val {expval_proc :: Proc} 34 | 35 | instance Show ExpVal where 36 | show (Num_Val num) = show num 37 | show (Bool_Val bool) = show bool 38 | show (Proc_Val proc) = show "" 39 | 40 | -- Denoted values 41 | type DenVal = ExpVal 42 | 43 | -- Procedure values : data structures 44 | data Proc = Procedure {var :: Identifier, body :: Exp, saved_env :: Env} 45 | 46 | procedure :: Identifier -> Exp -> Env -> Proc 47 | procedure var body env = Procedure var body env 48 | 49 | -- In Interp.hs 50 | -- apply_procedure :: Proc -> ExpVal -> ExpVal 51 | 52 | -------------------------------------------------------------------------------- /ch5/app/letreccps/Expr.hs: -------------------------------------------------------------------------------- 1 | module Expr(Program,Exp(..),Identifier) where 2 | 3 | type Program = Exp 4 | 5 | data Exp = 6 | Const_Exp Int 7 | | Diff_Exp Exp Exp 8 | | IsZero_Exp Exp 9 | | If_Exp Exp Exp Exp 10 | | Var_Exp Identifier 11 | | Let_Exp Identifier Exp Exp 12 | | Letrec_Exp Identifier Identifier Exp Exp -- letrec f(x) = ... recusive expr ... 13 | | Proc_Exp Identifier Exp -- proc 14 | | Call_Exp Exp Exp -- call 15 | deriving Show 16 | 17 | type Identifier = String 18 | 19 | -------------------------------------------------------------------------------- /ch5/app/letreccps/Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer(lexerSpec) where 2 | 3 | import Prelude hiding (EQ) 4 | import CommonParserUtil 5 | import Token 6 | 7 | mkFn :: Token -> LexAction Token IO () 8 | mkFn tok = \text -> return $ Just tok 9 | 10 | skip :: LexAction Token IO () 11 | skip = \text -> return $ Nothing 12 | 13 | lexerSpec :: LexerSpec Token IO () 14 | lexerSpec = LexerSpec 15 | { 16 | endOfToken = END_OF_TOKEN, 17 | lexerSpecList = 18 | [ ("[ \t\n]" , skip), 19 | 20 | ("[0-9]+" , mkFn INTEGER_NUMBER), 21 | 22 | ("\\-" , mkFn SUB), 23 | ("\\(" , mkFn OPEN_PAREN), 24 | ("\\)" , mkFn CLOSE_PAREN), 25 | ("\\," , mkFn COMMA), 26 | 27 | ("zero\\?" , mkFn ISZERO), 28 | 29 | ("if" , mkFn IF), 30 | ("then" , mkFn THEN), 31 | ("else" , mkFn ELSE), 32 | 33 | ("letrec" , mkFn LETREC), 34 | 35 | ("let" , mkFn LET), 36 | ("in" , mkFn IN), 37 | ("\\=" , mkFn EQ), 38 | 39 | ("proc" , mkFn PROC), 40 | 41 | ("[a-zA-Z][a-zA-Z0-9]*" , mkFn IDENTIFIER) 42 | ] 43 | } 44 | -------------------------------------------------------------------------------- /ch5/app/letreccps/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | main :: IO () 17 | main = 18 | do args <- getArgs 19 | _main args 20 | 21 | 22 | _main [] = return () 23 | _main (fileName:args) = 24 | case fileName of 25 | _ -> do _ <- doProcess True fileName 26 | _main args 27 | 28 | 29 | doProcess verbose fileName = do 30 | putStrLn fileName 31 | text <- readFile fileName 32 | let debugFlag = False 33 | 34 | expression <- 35 | parsing debugFlag 36 | parserSpec ((), 1, 1, text) 37 | (aLexer lexerSpec) 38 | (fromToken (endOfToken lexerSpec)) 39 | 40 | putStrLn (show expression) 41 | 42 | let val = value_of_program expression 43 | putStrLn (show val) 44 | 45 | -------------------------------------------------------------------------------- /ch5/app/letreccps/MainUtil.hs: -------------------------------------------------------------------------------- 1 | module MainUtil where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | parser text = do 17 | parsing False -- parser converting a text-based program 18 | parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 19 | (aLexer lexerSpec) 20 | (fromToken (endOfToken lexerSpec)) 21 | 22 | run text = do 23 | val <- runProg text True 24 | putStrLn (show val) 25 | 26 | runProg text bool = do 27 | expression <- parser text 28 | 29 | if bool then putStrLn (show expression) else return () 30 | 31 | let val = value_of_program expression -- interpreter 32 | return val 33 | -------------------------------------------------------------------------------- /ch5/app/letreccps/Parser.hs: -------------------------------------------------------------------------------- 1 | module Parser where 2 | 3 | import CommonParserUtil 4 | import Token 5 | import Expr 6 | 7 | -- | Utility 8 | rule prodRule action = (prodRule, action, Nothing ) 9 | ruleWithPrec prodRule action prec = (prodRule, action, Just prec) 10 | 11 | -- 12 | parserSpec :: ParserSpec Token Exp IO () 13 | parserSpec = ParserSpec 14 | { 15 | startSymbol = "Expression'", 16 | 17 | tokenPrecAssoc = [], 18 | 19 | parserSpecList = 20 | [ 21 | rule "Expression' -> Expression" (\rhs -> return $ get rhs 1), 22 | 23 | rule "Expression -> integer_number" 24 | (\rhs -> return $ Const_Exp (read (getText rhs 1) :: Int)), 25 | 26 | rule "Expression -> - integer_number" 27 | (\rhs -> return $ Const_Exp (-(read (getText rhs 2) :: Int))), 28 | 29 | rule "Expression -> - ( Expression , Expression )" 30 | (\rhs -> return $ Diff_Exp (get rhs 3) (get rhs 5)), 31 | 32 | rule "Expression -> zero? ( Expression )" 33 | (\rhs -> return $ IsZero_Exp (get rhs 3)), 34 | 35 | rule "Expression -> if Expression then Expression else Expression" 36 | (\rhs -> return $ If_Exp (get rhs 2) (get rhs 4) (get rhs 6)), 37 | 38 | rule "Expression -> identifier" (\rhs -> return $ Var_Exp (getText rhs 1)), 39 | 40 | rule "Expression -> let identifier = Expression in Expression" 41 | (\rhs -> return $ Let_Exp (getText rhs 2) (get rhs 4) (get rhs 6)), 42 | 43 | rule "Expression -> letrec identifier ( identifier ) = Expression in Expression" 44 | (\rhs -> return $ Letrec_Exp (getText rhs 2) (getText rhs 4) (get rhs 7) (get rhs 9)), 45 | 46 | rule "Expression -> proc ( identifier ) Expression" 47 | (\rhs -> return $ Proc_Exp (getText rhs 3) (get rhs 5)), 48 | 49 | rule "Expression -> ( Expression Expression )" 50 | (\rhs -> return $ Call_Exp (get rhs 2) (get rhs 3)) 51 | ], 52 | 53 | baseDir = "./", 54 | actionTblFile = "action_table_letreccps.txt", 55 | gotoTblFile = "goto_table_letreccps.txt", 56 | grammarFile = "prod_rules_letreccps.txt", 57 | parserSpecFile = "mygrammar_letreccps.grm", 58 | genparserexe = "yapb-exe" 59 | } 60 | 61 | 62 | -------------------------------------------------------------------------------- /ch5/app/letreccps/Token.hs: -------------------------------------------------------------------------------- 1 | module Token(Token(..)) where 2 | 3 | import Prelude hiding(EQ) 4 | import TokenInterface 5 | 6 | data Token = 7 | END_OF_TOKEN 8 | 9 | | INTEGER_NUMBER -- number 10 | 11 | | SUB -- - ( expr1, expr2 ) 12 | | OPEN_PAREN | CLOSE_PAREN 13 | | COMMA 14 | 15 | | ISZERO -- zero? ( expr ) 16 | 17 | | IF -- if expr1 then expr2 else expr3 18 | | THEN 19 | | ELSE 20 | 21 | | LET -- let identifier = expr1 in expr2 22 | | IN 23 | | EQ 24 | 25 | | LETREC -- letrec identifier ( identifier )= expr1 in expr2 26 | 27 | | PROC -- proc ( identifier ) expr 28 | -- (expr1 expr2) 29 | 30 | | IDENTIFIER -- identifier 31 | deriving (Eq, Show) 32 | 33 | tokenStrList :: [(Token,String)] 34 | tokenStrList = 35 | [ (END_OF_TOKEN, "$"), 36 | 37 | (INTEGER_NUMBER, "integer_number"), 38 | 39 | (SUB, "-"), 40 | (OPEN_PAREN, "("), 41 | (CLOSE_PAREN, ")"), 42 | (COMMA, ","), 43 | 44 | (ISZERO, "zero?"), 45 | 46 | (IF, "if"), 47 | (THEN, "then"), 48 | (ELSE, "else"), 49 | 50 | (IDENTIFIER, "identifier"), 51 | 52 | (LET, "let"), 53 | (IN, "in"), 54 | (EQ, "="), 55 | 56 | (LETREC, "letrec"), 57 | 58 | (PROC, "proc") 59 | ] 60 | 61 | findTok tok [] = Nothing 62 | findTok tok ((tok_,str):list) 63 | | tok == tok_ = Just str 64 | | otherwise = findTok tok list 65 | 66 | findStr str [] = Nothing 67 | findStr str ((tok,str_):list) 68 | | str == str_ = Just tok 69 | | otherwise = findStr str list 70 | 71 | instance TokenInterface Token where 72 | -- toToken str = 73 | -- case findStr str tokenStrList of 74 | -- Nothing -> error ("toToken: " ++ str) 75 | -- Just tok -> tok 76 | fromToken tok = 77 | case findTok tok tokenStrList of 78 | Nothing -> error ("fromToken: " ++ show tok) 79 | Just str -> str 80 | 81 | 82 | isEOT END_OF_TOKEN = True 83 | isEOT _ = False 84 | -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/apply_proc_in_rator_pos.proc: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/apply_simple_proc.proc: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/check_shadowing_in_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = 4 in x -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/check_shadowing_in_rhs.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = -(x,1) in x -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/eval_let_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in -(x,1) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/eval_let_rhs.let: -------------------------------------------------------------------------------- 1 | let x = -(4,1) in -(x,1) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/ho_nested_letrecs.letrec: -------------------------------------------------------------------------------- 1 | letrec even(odd) = proc(x) if zero?(x) then 1 else (odd -(x,1)) 2 | in letrec odd(x) = if zero?(x) then 0 else ((even odd) -(x,1)) 3 | in (odd 13) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/if_eval_test_false.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/if_eval_test_false_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then foo else 4 -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/if_eval_test_true.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/if_eval_test_true_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else foo -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/if_false.let: -------------------------------------------------------------------------------- 1 | if zero?(1) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/if_true.let: -------------------------------------------------------------------------------- 1 | if zero?(0) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/let_to_proc_1.proc: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/negative_const.let: -------------------------------------------------------------------------------- 1 | -33 -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/nested_arith_left.let: -------------------------------------------------------------------------------- 1 | -(-(44,33),22) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/nested_arith_right.let: -------------------------------------------------------------------------------- 1 | -(55,-(22,11)) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/nested_procs_1.proc: -------------------------------------------------------------------------------- 1 | ((proc (x) proc (y) -(x,y) 5) 6) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/nested_procs_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/no_bool_to_diff_1.let: -------------------------------------------------------------------------------- 1 | -(zero?(0),1) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/no_bool_to_diff_2.let: -------------------------------------------------------------------------------- 1 | -(1,zero?(0)) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/no_int_to_if.let: -------------------------------------------------------------------------------- 1 | if 1 then 2 else 3 2 | -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/positive_const.let: -------------------------------------------------------------------------------- 1 | 11 -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/simple_app_1.proc: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/simple_app_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/simple_app_3.proc: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/simple_arith_1.let: -------------------------------------------------------------------------------- 1 | -(44,33) 2 | -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/simple_arith_var_1.let: -------------------------------------------------------------------------------- 1 | -(44,x) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/simple_let_1.let: -------------------------------------------------------------------------------- 1 | let x = 3 in x -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/simple_letrec_1.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = -(x,1) in (f 33) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/simple_letrec_2.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/simple_letrec_3.letrec: -------------------------------------------------------------------------------- 1 | let m = -5 2 | in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/simple_nested_let.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let y = 4 in -(x,y) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/test_unbound_var_1.let: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/test_unbound_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,foo) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/test_var_1.let: -------------------------------------------------------------------------------- 1 | x -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/test_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,1) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/test_var_3.let: -------------------------------------------------------------------------------- 1 | -(1,x) -------------------------------------------------------------------------------- /ch5/app/letreccps/examples/y_combinator_1.proc: -------------------------------------------------------------------------------- 1 | let fix = proc (f) 2 | let d = proc (x) proc (z) ((f (x x)) z) 3 | in proc (n) ((f (d d)) n) 4 | in let 5 | t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4) 6 | in let times4 = (fix t4m) 7 | in (times4 3) -------------------------------------------------------------------------------- /ch5/app/threads/Expr.hs: -------------------------------------------------------------------------------- 1 | module Expr(Program,Exp(..),Identifier,UnaryOp(..)) where 2 | 3 | type Program = Exp 4 | 5 | data Exp = 6 | Const_Exp Int 7 | | Diff_Exp Exp Exp 8 | | If_Exp Exp Exp Exp 9 | | Var_Exp Identifier -- variable : x 10 | | Let_Exp Identifier Exp Exp -- let x = expression in expression 11 | | Letrec_Exp 12 | [(Identifier,Identifier,Exp)] Exp -- letrec { ..., f_i(x_i) = expression_i, ... } in expression 13 | | Proc_Exp Identifier Exp -- proc ( identifier ) expression 14 | | Call_Exp Exp Exp -- ( expression expression) 15 | | Block_Exp [ Exp ] -- begin exp1; ...; expk end 16 | | Set_Exp Identifier Exp -- set x = expression 17 | | Spawn_Exp Exp -- spawn ( expression ) 18 | | Yield_Exp -- yield () 19 | | Mutex_Exp -- mutex () 20 | | Wait_Exp Exp -- wait ( expression ) 21 | | Signal_Exp Exp -- signal ( expression ) 22 | | Const_List_Exp [Int] -- number list : [ number1, ..., numberk ] 23 | | Unary_Exp UnaryOp Exp -- unop ( expression ) where unop is one of car, cdr, null?, zero? print 24 | -- | Try_Exp Exp Identifier Exp -- try exp catch exn exp 25 | -- | Raise_Exp Exp -- raise exp 26 | deriving Show 27 | 28 | data UnaryOp = IsZero | IsNull | Car | Cdr | Print deriving Show 29 | 30 | type Identifier = String 31 | 32 | -------------------------------------------------------------------------------- /ch5/app/threads/Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer(lexerSpec) where 2 | 3 | import Prelude hiding (EQ) 4 | import CommonParserUtil 5 | import Token 6 | 7 | mkFn :: Token -> LexAction Token IO () 8 | mkFn tok = \text -> return $ Just tok 9 | 10 | skip :: LexAction Token IO () 11 | skip = \text -> return $ Nothing 12 | 13 | lexerSpec :: LexerSpec Token IO () 14 | lexerSpec = LexerSpec 15 | { 16 | endOfToken = END_OF_TOKEN, 17 | lexerSpecList = 18 | [ ("[ \t\n]" , skip), 19 | 20 | ("[0-9]+" , mkFn INTEGER_NUMBER), 21 | 22 | ("\\-" , mkFn SUB), 23 | ("\\(" , mkFn OPEN_PAREN), 24 | ("\\)" , mkFn CLOSE_PAREN), 25 | ("\\," , mkFn COMMA), 26 | 27 | ("\\=" , mkFn EQ), 28 | 29 | (";" , mkFn SEMICOLON), 30 | 31 | ("\\[" , mkFn OPEN_BRACKET), 32 | ("\\]" , mkFn CLOSE_BRACKET), 33 | 34 | -- identifiers ending with a symbol 35 | ("zero\\?" , mkFn ISZERO), 36 | ("null\\?" , mkFn ISNULL), 37 | 38 | ("[a-zA-Z][a-zA-Z0-9]*" , keywordOrIdentifier) 39 | ] 40 | } 41 | 42 | keywordOrIdentifier text = 43 | case lookup text keywords of 44 | Nothing -> mkFn IDENTIFIER text 45 | Just tok -> mkFn tok text 46 | 47 | keywords = 48 | [ ("if", IF) 49 | , ("then", THEN) 50 | , ("else", ELSE) 51 | , ("letrec", LETREC) 52 | , ("let", LET) 53 | , ("proc", PROC) 54 | , ("begin", BEGIN) 55 | , ("end", END) 56 | , ("set", SET) 57 | , ("spawn", SPAWN) 58 | , ("yield", YIELD) 59 | , ("mutex", MUTEX) 60 | , ("wait", WAIT) 61 | , ("signal", SIGNAL) 62 | , ("car", CAR) 63 | , ("cdr", CDR) 64 | , ("print", PRINT) 65 | , ("in", IN) 66 | ] 67 | 68 | -------------------------------------------------------------------------------- /ch5/app/threads/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | main :: IO () 17 | main = 18 | do args <- getArgs 19 | _main args 20 | 21 | 22 | _main [] = return () 23 | _main (fileName:args) = 24 | case fileName of 25 | _ -> do _ <- doProcess True fileName 26 | _main args 27 | 28 | 29 | doProcess verbose fileName = do 30 | putStrLn fileName 31 | text <- readFile fileName 32 | let debugFlag = False 33 | 34 | expression <- 35 | parsing debugFlag 36 | parserSpec ((), 1, 1, text) 37 | (aLexer lexerSpec) 38 | (fromToken (endOfToken lexerSpec)) 39 | 40 | putStrLn (show expression) 41 | 42 | let val = value_of_program expression timeslice 43 | putStrLn (show val) 44 | 45 | parser text = do 46 | parsing False -- parser converting a text-based program 47 | parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 48 | (aLexer lexerSpec) 49 | (fromToken (endOfToken lexerSpec)) 50 | 51 | timeslice = 5 52 | 53 | run text = do 54 | expression <- parser text 55 | 56 | putStrLn (show expression) 57 | let val = value_of_program expression timeslice -- interpreter 58 | putStrLn (show val) 59 | -------------------------------------------------------------------------------- /ch5/app/threads/MainUtil.hs: -------------------------------------------------------------------------------- 1 | module MainUtil where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | import Scheduler(timeslice) 12 | 13 | import Control.Monad (when) 14 | import System.IO 15 | import System.Environment (getArgs, withArgs) 16 | 17 | 18 | parser text = do 19 | parsing False -- parser converting a text-based program 20 | parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 21 | (aLexer lexerSpec) 22 | (fromToken (endOfToken lexerSpec)) 23 | 24 | runProg text bool = do 25 | expression <- parser text 26 | 27 | if bool then putStrLn (show expression) else return () 28 | 29 | let val = value_of_program expression timeslice -- interpreter 30 | putStrLn (show val) 31 | 32 | run text = runProg text True 33 | -------------------------------------------------------------------------------- /ch5/app/threads/Queue.hs: -------------------------------------------------------------------------------- 1 | module Queue where 2 | 3 | type Queue a = [a] 4 | 5 | empty_queue :: Queue a 6 | empty_queue = [] 7 | 8 | isempty :: Queue a -> Bool 9 | isempty queue = null queue 10 | 11 | enqueue :: Queue a -> a -> Queue a 12 | enqueue queue elem = queue ++ [elem] 13 | 14 | dequeueWithFun :: Queue a -> (a -> Queue a -> b) -> b 15 | dequeueWithFun queue f = f (head queue) (tail queue) 16 | -- Note that dequeue is used in run_next_thread:Schedule.hs and 17 | -- singal_mutex:Semaphore.hs where 18 | -- 19 | -- b = Store -> SchedState -> (FinalAnswer, Store). 20 | -- 21 | -- One can implement dequeue as usual 22 | -- 23 | -- dequeue :: Queue a -> (a, Queue a) 24 | -- 25 | -- so that dequeue queue f can be rewritten as 26 | -- 27 | -- let (head, queue') = dequeue queue in 28 | -- f head queue'. 29 | -- 30 | 31 | 32 | -- Replaced by some nonstandard interface, dequeueWithFun. 33 | dequeue :: Queue a -> (a, Queue a) 34 | dequeue q = if isempty q 35 | then error "dequeue: fail to dequeue from the empty queue" 36 | else (head q, tail q) 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /ch5/app/threads/Scheduler.hs: -------------------------------------------------------------------------------- 1 | module Scheduler where 2 | 3 | import EnvStore 4 | import Queue 5 | import Data.Maybe 6 | 7 | -- 8 | timeslice = 5 9 | 10 | -- 11 | initialize_scheduler :: Integer -> SchedState 12 | initialize_scheduler ticks = 13 | SchedState { 14 | the_ready_queue = empty_queue, 15 | the_final_answer = Nothing, 16 | the_max_time_slice = ticks, 17 | the_time_remaining = ticks 18 | } 19 | 20 | place_on_ready_queue :: Thread -> SchedState -> SchedState 21 | place_on_ready_queue th scState = 22 | scState { the_ready_queue = enqueue (the_ready_queue scState) th } 23 | 24 | run_next_thread :: Store -> SchedState -> (FinalAnswer, Store) 25 | run_next_thread store scState = 26 | if isempty (the_ready_queue scState) 27 | then (fromJust (the_final_answer scState), store) 28 | else 29 | dequeueWithFun (the_ready_queue scState) 30 | (\first_ready_thread other_ready_threads -> 31 | first_ready_thread 32 | store 33 | ( scState { the_ready_queue = other_ready_threads, 34 | the_time_remaining = the_max_time_slice scState } ) ) 35 | 36 | set_final_answer :: SchedState -> ExpVal -> SchedState 37 | set_final_answer scState val = scState { the_final_answer = Just val } 38 | 39 | time_expired :: SchedState -> Bool 40 | time_expired scState = the_time_remaining scState==0 41 | 42 | decrement_timer :: SchedState -> SchedState 43 | decrement_timer scState = scState { the_time_remaining = the_time_remaining scState - 1 } 44 | -------------------------------------------------------------------------------- /ch5/app/threads/Semaphores.hs: -------------------------------------------------------------------------------- 1 | module Semaphores where 2 | 3 | import EnvStore 4 | import Queue 5 | import Scheduler 6 | 7 | new_mutex :: Store -> (Mutex, Store) 8 | new_mutex store = 9 | let (b,store') = newref store (Bool_Val False) 10 | (q,store'') = newref store' (Queue_Val empty_queue) 11 | in (Mutex b q, store'') 12 | 13 | wait_for_mutex :: Mutex -> Thread -> Store -> SchedState -> (FinalAnswer, Store) 14 | wait_for_mutex mutex thread store sched = 15 | let Mutex ref_to_closed ref_to_wait_queue = mutex 16 | closed = deref store ref_to_closed 17 | b = expval_bool closed 18 | 19 | -- Then 20 | wait_queue = deref store ref_to_wait_queue 21 | q = expval_queue wait_queue 22 | q' = enqueue q thread 23 | qval = Queue_Val q' 24 | then_store' = setref store ref_to_wait_queue qval 25 | 26 | -- Else 27 | else_store' = setref store ref_to_closed (Bool_Val True) 28 | in 29 | if b 30 | then run_next_thread then_store' sched 31 | else thread else_store' sched 32 | 33 | signal_mutex :: Mutex -> Thread -> Store -> SchedState -> (FinalAnswer, Store) 34 | signal_mutex mutex thread store sched = 35 | let Mutex ref_to_closed ref_to_wait_queue = mutex 36 | closed = deref store ref_to_closed 37 | b = expval_bool closed 38 | 39 | wait_queue = deref store ref_to_wait_queue 40 | q = expval_queue wait_queue 41 | 42 | in if b 43 | then if isempty q 44 | then let store' = setref store ref_to_closed (Bool_Val False) 45 | in thread store' sched 46 | else dequeueWithFun q 47 | (\first_waiting_thread other_waiting_threads store1 sched1 -> 48 | let sched1' = place_on_ready_queue first_waiting_thread sched1 49 | store1' = setref store1 ref_to_wait_queue 50 | (Queue_Val other_waiting_threads) 51 | in thread store1' sched1') store sched 52 | else thread store sched 53 | 54 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/apply_proc_in_rator_pos.let: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch5/app/threads/examples/apply_simple_proc.let: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch5/app/threads/examples/assignment_test_1.impref: -------------------------------------------------------------------------------- 1 | let x = 17 2 | in begin set x = 27; x end -------------------------------------------------------------------------------- /ch5/app/threads/examples/begin_1.impref: -------------------------------------------------------------------------------- 1 | begin 33 end -------------------------------------------------------------------------------- /ch5/app/threads/examples/begin_2.impref: -------------------------------------------------------------------------------- 1 | begin 33; 44 end -------------------------------------------------------------------------------- /ch5/app/threads/examples/begin_test_1.letrec_ext: -------------------------------------------------------------------------------- 1 | begin 1; 2; 3 end -------------------------------------------------------------------------------- /ch5/app/threads/examples/car_1.exn: -------------------------------------------------------------------------------- 1 | car(list(2,3,4)) 2 | 3 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/cdr_1.exn: -------------------------------------------------------------------------------- 1 | cdr(list(2,3,4)) 2 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/check_shadowing_in_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = 4 in x -------------------------------------------------------------------------------- /ch5/app/threads/examples/check_shadowing_in_rhs.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let x = -(x,1) in x -------------------------------------------------------------------------------- /ch5/app/threads/examples/dont_run_handler_til_failure.exn: -------------------------------------------------------------------------------- 1 | try 33 2 | catch (m) foo -------------------------------------------------------------------------------- /ch5/app/threads/examples/eval_let_body.let: -------------------------------------------------------------------------------- 1 | let x = 3 in -(x,1) -------------------------------------------------------------------------------- /ch5/app/threads/examples/eval_let_rhs.let: -------------------------------------------------------------------------------- 1 | let x = -(4,1) in -(x,1) -------------------------------------------------------------------------------- /ch5/app/threads/examples/even_odd_via_set_1.impref: -------------------------------------------------------------------------------- 1 | let x = 0 2 | in letrec even(d) = if zero?(x) then 1 3 | else let d = set x = -(x,1) 4 | in (odd d) 5 | odd(d) = if zero?(x) then 0 6 | else let d = set x = -(x,1) 7 | in (even d) 8 | in let d = set x = 13 in (odd -99) -------------------------------------------------------------------------------- /ch5/app/threads/examples/example_for_book_1.impref: -------------------------------------------------------------------------------- 1 | let f = proc (x) proc (y) 2 | begin 3 | set x = -(x,-1); 4 | -(x,y) 5 | end 6 | in ((f 44) 33) -------------------------------------------------------------------------------- /ch5/app/threads/examples/exceptions_have_dynamic_scope_1.exn: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x, -(raise 99, 1)) 2 | in try (f 33) 3 | catch (m) 44 4 | 5 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/gensym_test_1.impref: -------------------------------------------------------------------------------- 1 | let g = let count = 0 in proc(d) 2 | let d = set count = -(count,-1) 3 | in count 4 | in -((g 11), (g 22)) -------------------------------------------------------------------------------- /ch5/app/threads/examples/handler_in_non_tail_recursive_position.exn: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x, -(raise 99, 1)) 2 | in -(try (f 33) 3 | catch (m) -(m,55), 4 | 1) 5 | 6 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/ho_nested_letrecs.letrec: -------------------------------------------------------------------------------- 1 | letrec even(odd) = proc(x) if zero?(x) then 1 else (odd -(x,1)) 2 | in letrec odd(x) = if zero?(x) then 0 else ((even odd) -(x,1)) 3 | in (odd 13) -------------------------------------------------------------------------------- /ch5/app/threads/examples/if_eval_test_false.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/threads/examples/if_eval_test_false_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,12)) then foo else 4 -------------------------------------------------------------------------------- /ch5/app/threads/examples/if_eval_test_true.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/threads/examples/if_eval_test_true_2.let: -------------------------------------------------------------------------------- 1 | if zero?(-(11,11)) then 3 else foo -------------------------------------------------------------------------------- /ch5/app/threads/examples/if_false.let: -------------------------------------------------------------------------------- 1 | if zero?(1) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/threads/examples/if_true.let: -------------------------------------------------------------------------------- 1 | if zero?(0) then 3 else 4 -------------------------------------------------------------------------------- /ch5/app/threads/examples/insanely_simple_spawn.thr: -------------------------------------------------------------------------------- 1 | begin spawn(proc(d) 3); 44 end 2 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/let_to_proc_1.let: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch5/app/threads/examples/lists_1.exn: -------------------------------------------------------------------------------- 1 | list(2, 3, 4) 2 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/negative_const.let: -------------------------------------------------------------------------------- 1 | -33 -------------------------------------------------------------------------------- /ch5/app/threads/examples/nested_arith_left.let: -------------------------------------------------------------------------------- 1 | -(-(44,33),22) -------------------------------------------------------------------------------- /ch5/app/threads/examples/nested_arith_right.let: -------------------------------------------------------------------------------- 1 | -(55,-(22,11)) -------------------------------------------------------------------------------- /ch5/app/threads/examples/nested_procs_1.proc: -------------------------------------------------------------------------------- 1 | ((proc (x) proc (y) -(x,y) 5) 6) -------------------------------------------------------------------------------- /ch5/app/threads/examples/nested_procs_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6) -------------------------------------------------------------------------------- /ch5/app/threads/examples/no_bool_to_diff_1.let: -------------------------------------------------------------------------------- 1 | -(zero?(0),1) -------------------------------------------------------------------------------- /ch5/app/threads/examples/no_bool_to_diff_2.let: -------------------------------------------------------------------------------- 1 | -(1,zero?(0)) -------------------------------------------------------------------------------- /ch5/app/threads/examples/no_int_to_if.let: -------------------------------------------------------------------------------- 1 | if 1 then 2 else 3 2 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/positive_const.let: -------------------------------------------------------------------------------- 1 | 11 -------------------------------------------------------------------------------- /ch5/app/threads/examples/producer_consumer.thr: -------------------------------------------------------------------------------- 1 | let buffer = 0 2 | in let 3 | producer = proc (n) 4 | letrec 5 | loop(k) = if zero?(k) 6 | then set buffer = n 7 | else begin 8 | print(-(k,-200)); 9 | yield(); 10 | (loop -(k,1)) 11 | end 12 | in (loop 5) 13 | in let consumer = proc (d) letrec 14 | busywait (k) = if zero?(buffer) 15 | then begin 16 | print(-(k,-100)); 17 | yield(); 18 | (busywait -(k,-1)) 19 | end 20 | else buffer 21 | in (busywait 0) 22 | in 23 | begin 24 | spawn(proc (d) (producer 44)); 25 | (consumer 88) 26 | end 27 | 28 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/producer_consumer_with_mutex.thr: -------------------------------------------------------------------------------- 1 | let buffer = 0 2 | in let mut = mutex() 3 | in let 4 | producer = proc (n) 5 | letrec 6 | waitloop(k) 7 | = if zero?(k) 8 | then 9 | begin 10 | set buffer = n; 11 | signal(mut) 12 | end 13 | else 14 | begin 15 | print(-(k,-200)); 16 | (waitloop -(k,1)) 17 | end 18 | in (waitloop 5) 19 | in let consumer = proc (d) 20 | begin 21 | wait(mut); 22 | buffer 23 | end 24 | in 25 | begin 26 | wait(mut); 27 | spawn(proc (d) (producer 44)); 28 | print(300); 29 | (consumer 86) 30 | end -------------------------------------------------------------------------------- /ch5/app/threads/examples/propagate_error_1.exn: -------------------------------------------------------------------------------- 1 | try try -(raise 23, 11) 2 | catch (m) -(raise 22,1) 3 | catch (m) m 4 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/propagate_error_2.exn: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(1, raise 99) 2 | in 3 | try 4 | try (f 44) 5 | catch (exc) (f 23) 6 | catch (exc) 11 7 | 8 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/safe_ctr.thr: -------------------------------------------------------------------------------- 1 | let ctr = let x = 0 in let mut = mutex() 2 | in proc (n) proc (d) 3 | begin 4 | wait(mut); 5 | print(n); 6 | print(x); 7 | set x = -(x,-1); 8 | print(n); 9 | print(x); 10 | signal(mut) 11 | end 12 | in begin 13 | spawn((ctr 100)); 14 | spawn((ctr 200)); 15 | spawn((ctr 300)); 16 | 999 17 | end 18 | 19 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_app_1.proc: -------------------------------------------------------------------------------- 1 | (proc(x) -(x,1) 30) -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_app_2.proc: -------------------------------------------------------------------------------- 1 | let f = proc (x) -(x,1) in (f 30) -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_app_3.proc: -------------------------------------------------------------------------------- 1 | (proc(f)(f 30) proc(x)-(x,1)) -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_arith_1.let: -------------------------------------------------------------------------------- 1 | -(44,33) 2 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_failure.exn: -------------------------------------------------------------------------------- 1 | try -(1, raise 44) catch (m) m 2 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_let_1.let: -------------------------------------------------------------------------------- 1 | let x = 3 in x -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_letrec_1.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = -(x,1) in (f 33) -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_letrec_2.letrec: -------------------------------------------------------------------------------- 1 | letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4) -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_letrec_3.letrec: -------------------------------------------------------------------------------- 1 | let m = -5 2 | in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4) -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_nested_let.let: -------------------------------------------------------------------------------- 1 | let x = 3 in let y = 4 in -(x,y) -------------------------------------------------------------------------------- /ch5/app/threads/examples/simple_succeed.exn: -------------------------------------------------------------------------------- 1 | try 33 2 | catch (m) 44 3 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/test_unbound_var_1.let: -------------------------------------------------------------------------------- 1 | foo -------------------------------------------------------------------------------- /ch5/app/threads/examples/test_unbound_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,foo) -------------------------------------------------------------------------------- /ch5/app/threads/examples/test_var_1.let: -------------------------------------------------------------------------------- 1 | x -------------------------------------------------------------------------------- /ch5/app/threads/examples/test_var_2.let: -------------------------------------------------------------------------------- 1 | -(x,1) -------------------------------------------------------------------------------- /ch5/app/threads/examples/test_var_3.let: -------------------------------------------------------------------------------- 1 | -(1,x) -------------------------------------------------------------------------------- /ch5/app/threads/examples/text_example_0_1.exn: -------------------------------------------------------------------------------- 1 | let index 2 | = proc (n) 3 | letrec inner2 (lst) 4 | = if null?(lst) then lst 5 | else if zero?(-(car(lst),n)) then lst 6 | else let v = (inner2 cdr(lst)) 7 | in v 8 | in proc (lst) 9 | try (inner2 lst) 10 | catch (x) -1 11 | in ((index 3) list(2, 3, 4)) 12 | 13 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/text_example_0_2.exn: -------------------------------------------------------------------------------- 1 | let index 2 | = proc (n) 3 | letrec inner2 (lst) 4 | = if null?(lst) then lst 5 | else if zero?(-(car(lst),n)) then lst 6 | else let v = (inner2 cdr(lst)) 7 | in v 8 | in proc (lst) 9 | try (inner2 lst) 10 | catch (x) -1 11 | in ((index 3) list(2, 3, 4)) 12 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/text_example_1_1.exn: -------------------------------------------------------------------------------- 1 | let index 2 | = proc (n) 3 | letrec inner2 (lst) 4 | = if null?(lst) then raise 99 5 | else if zero?(-(car(lst),n)) then 0 6 | else let v = (inner2 cdr(lst)) 7 | in -(v,-1) 8 | in proc (lst) 9 | try (inner2 lst) 10 | catch (x) -1 11 | in ((index 2) list(2, 3, 4)) 12 | 13 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/text_example_1_2.exn: -------------------------------------------------------------------------------- 1 | let index 2 | = proc (n) 3 | letrec inner2 (lst) 4 | = if null?(lst) then raise 99 5 | else if zero?(-(car(lst),n)) then 0 6 | else -((inner2 cdr(lst)), -1) 7 | in proc (lst) 8 | try (inner2 lst) 9 | catch (x) -1 10 | in ((index 5) list(2, 3)) 11 | 12 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/twice.letrec: -------------------------------------------------------------------------------- 1 | (proc (twice) 2 | ((twice proc (z) -(z,1)) 11) 3 | proc (f) proc (x) (f (f x))) -------------------------------------------------------------------------------- /ch5/app/threads/examples/two_non_cooperating_threads.thr: -------------------------------------------------------------------------------- 1 | letrec 2 | noisy (l) = if null?(l) 3 | then 0 4 | else begin print(car(l)); (noisy cdr(l)) end 5 | in 6 | begin 7 | spawn(proc (d) (noisy [1,2,3,4,5])) ; 8 | spawn(proc (d) (noisy [6,7,8,9,10])) ; 9 | print(100); 10 | 33 11 | end 12 | 13 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/two_threads.thr: -------------------------------------------------------------------------------- 1 | letrec 2 | noisy (l) = if null?(l) 3 | then 0 4 | else begin print(car(l)); yield() ; (noisy cdr(l)) end 5 | in 6 | begin 7 | spawn(proc (d) (noisy [1,2,3,4,5])) ; 8 | spawn(proc (d) (noisy [6,7,8,9,10])); 9 | print(100); 10 | 33 11 | end 12 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/uncaught_exception.exn: -------------------------------------------------------------------------------- 1 | -(22, raise 13) 2 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/unsafe_ctr.thr: -------------------------------------------------------------------------------- 1 | let ctr = let x = 0 2 | in proc (n) proc (d) 3 | begin 4 | print(n); 5 | print(x); 6 | set x = -(x,-1); 7 | print(n); 8 | print(x) 9 | end 10 | in begin 11 | spawn((ctr 100)); 12 | spawn((ctr 200)); 13 | spawn((ctr 300)); 14 | 999 15 | end 16 | 17 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/unyielding_producer_consumer.thr: -------------------------------------------------------------------------------- 1 | let buffer = 0 2 | in let 3 | producer = proc (n) 4 | letrec 5 | waitloop(k) = if zero?(k) 6 | then set buffer = n 7 | else begin 8 | print(-(k,-200)); 9 | (waitloop -(k,1)) 10 | end 11 | in (waitloop 5) 12 | in let consumer = proc (d) letrec 13 | busywait (k) = if zero?(buffer) 14 | then begin 15 | print(-(k,-100)); 16 | (busywait -(k,-1)) 17 | end 18 | else buffer 19 | in (busywait 0) 20 | in 21 | begin 22 | spawn(proc (d) (producer 44)); 23 | print(300); 24 | (consumer 86) 25 | end 26 | 27 | -------------------------------------------------------------------------------- /ch5/app/threads/examples/y_combinator_1.proc: -------------------------------------------------------------------------------- 1 | let fix = proc (f) 2 | let d = proc (x) proc (z) ((f (x x)) z) 3 | in proc (n) ((f (d d)) n) 4 | in let 5 | t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4) 6 | in let times4 = (fix t4m) 7 | in (times4 3) -------------------------------------------------------------------------------- /ch5/app/threads/exceptions.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.34.4. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: exceptions 8 | version: 0.1.0.0 9 | description: Please see the README on GitHub at 10 | homepage: https://github.com/githubuser/exceptions#readme 11 | bug-reports: https://github.com/githubuser/exceptions/issues 12 | author: Author name here 13 | maintainer: example@example.com 14 | copyright: 2022 Author name here 15 | license: BSD3 16 | license-file: LICENSE 17 | build-type: Simple 18 | extra-source-files: 19 | README.md 20 | ChangeLog.md 21 | 22 | source-repository head 23 | type: git 24 | location: https://github.com/githubuser/exceptions 25 | 26 | library 27 | exposed-modules: 28 | Lib 29 | other-modules: 30 | Paths_exceptions 31 | hs-source-dirs: 32 | src 33 | build-depends: 34 | base >=4.7 && <5 35 | default-language: Haskell2010 36 | 37 | executable exceptions-exe 38 | main-is: Main.hs 39 | other-modules: 40 | Env 41 | Expr 42 | Interp 43 | Lexer 44 | Parser 45 | Setup 46 | Token 47 | Paths_exceptions 48 | hs-source-dirs: 49 | app 50 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 51 | build-depends: 52 | base >=4.7 && <5 53 | , exceptions 54 | default-language: Haskell2010 55 | 56 | test-suite exceptions-test 57 | type: exitcode-stdio-1.0 58 | main-is: Spec.hs 59 | other-modules: 60 | Paths_exceptions 61 | hs-source-dirs: 62 | test 63 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 64 | build-depends: 65 | base >=4.7 && <5 66 | , exceptions 67 | default-language: Haskell2010 68 | -------------------------------------------------------------------------------- /ch5/package.yaml: -------------------------------------------------------------------------------- 1 | name: ch5 2 | version: 0.1.0.0 3 | github: "githubuser/ch5" 4 | license: BSD3 5 | author: "Author name here" 6 | maintainer: "example@example.com" 7 | copyright: "2022 Author name here" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - yapb >= 0.2.3 25 | - hspec 26 | 27 | library: 28 | source-dirs: src 29 | 30 | executables: 31 | letreccps-exe: 32 | main: Main.hs 33 | source-dirs: app/letreccps 34 | ghc-options: 35 | - -threaded 36 | - -rtsopts 37 | - -with-rtsopts=-N 38 | dependencies: 39 | - ch5 40 | 41 | exceptions-exe: 42 | main: Main.hs 43 | source-dirs: app/exceptions 44 | ghc-options: 45 | - -threaded 46 | - -rtsopts 47 | - -with-rtsopts=-N 48 | dependencies: 49 | - ch5 50 | 51 | threads-exe: 52 | main: Main.hs 53 | source-dirs: app/threads 54 | ghc-options: 55 | - -threaded 56 | - -rtsopts 57 | - -with-rtsopts=-N 58 | dependencies: 59 | - ch5 60 | 61 | tests: 62 | letreccps-test: 63 | main: Spec.hs 64 | source-dirs: 65 | - test/letreccps 66 | - app/letreccps 67 | ghc-options: 68 | - -threaded 69 | - -rtsopts 70 | - -with-rtsopts=-N 71 | dependencies: 72 | - ch5 73 | 74 | 75 | exceptions-test: 76 | main: Spec.hs 77 | source-dirs: 78 | - test/exceptions 79 | - app/exceptions 80 | ghc-options: 81 | - -threaded 82 | - -rtsopts 83 | - -with-rtsopts=-N 84 | dependencies: 85 | - ch5 86 | -------------------------------------------------------------------------------- /ch5/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) where 4 | 5 | someFunc :: IO () 6 | someFunc = putStrLn "someFunc" 7 | -------------------------------------------------------------------------------- /ch5/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: yapb-0.2.3@sha256:d219b1ff4195682af24ae07b415b119ff164281444f0bcfcac9ed8550c850f40,4744 9 | pantry-tree: 10 | size: 3920 11 | sha256: 1e339417bc7a35c381209900cfbb127259c0228048f63f66c85b65f5dbb670d6 12 | original: 13 | hackage: yapb-0.2.3 14 | snapshots: 15 | - completed: 16 | size: 618683 17 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml 18 | sha256: d4ee004c46ba878d2f304f5d748d493057be579192a8d148527f3ba55c9df57f 19 | original: 20 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/4.yaml 21 | -------------------------------------------------------------------------------- /ch7/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `ch7` 2 | 3 | All notable changes to this project will be documented in this file. 4 | 5 | The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), 6 | and this project adheres to the 7 | [Haskell Package Versioning Policy](https://pvp.haskell.org/). 8 | 9 | ## Unreleased 10 | 11 | ## 0.1.0.0 - YYYY-MM-DD 12 | -------------------------------------------------------------------------------- /ch7/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2022 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ch7/README.md: -------------------------------------------------------------------------------- 1 | # ch7 2 | -------------------------------------------------------------------------------- /ch7/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ch7/app/checkedlang/Env.hs: -------------------------------------------------------------------------------- 1 | module Env where 2 | 3 | import Expr (Identifier,Exp) 4 | 5 | -- Environment 6 | data Env = 7 | Empty_env 8 | | Extend_env Identifier ExpVal Env 9 | | Extend_env_rec Identifier Identifier Exp Env 10 | 11 | empty_env :: Env 12 | empty_env = Empty_env 13 | 14 | apply_env :: Env -> Identifier -> ExpVal 15 | apply_env Empty_env search_var = error (search_var ++ " is not found.") 16 | apply_env (Extend_env saved_var saved_val saved_env) search_var 17 | | search_var==saved_var = saved_val 18 | | otherwise = apply_env saved_env search_var 19 | apply_env (Extend_env_rec p_name b_var p_body saved_env) search_var 20 | | p_name==search_var = Proc_Val (procedure b_var p_body (Extend_env_rec p_name b_var p_body saved_env)) 21 | | otherwise = apply_env saved_env search_var 22 | 23 | extend_env :: Identifier -> ExpVal -> Env -> Env 24 | extend_env x v env = Extend_env x v env 25 | 26 | extend_env_rec :: Identifier -> Identifier -> Exp -> Env -> Env 27 | extend_env_rec f x exp env = Extend_env_rec f x exp env 28 | 29 | -- Expressed values 30 | data ExpVal = 31 | Num_Val {expval_num :: Int} 32 | | Bool_Val {expval_bool :: Bool} 33 | | Proc_Val {expval_proc :: Proc} 34 | 35 | instance Show ExpVal where 36 | show (Num_Val num) = show num 37 | show (Bool_Val bool) = show bool 38 | show (Proc_Val proc) = show "" 39 | 40 | -- Denoted values 41 | type DenVal = ExpVal 42 | 43 | -- Procedure values : data structures 44 | data Proc = Procedure {var :: Identifier, body :: Exp, saved_env :: Env} 45 | 46 | procedure :: Identifier -> Exp -> Env -> Proc 47 | procedure var body env = Procedure var body env 48 | 49 | -- In Interp.hs 50 | -- apply_procedure :: Proc -> ExpVal -> ExpVal 51 | 52 | -------------------------------------------------------------------------------- /ch7/app/checkedlang/Expr.hs: -------------------------------------------------------------------------------- 1 | module Expr where 2 | 3 | import Data.Maybe 4 | 5 | -- for abstract syntax tree 6 | type Program = Exp 7 | 8 | data Exp = 9 | Const_Exp Int 10 | | Diff_Exp Exp Exp 11 | | IsZero_Exp Exp 12 | | If_Exp Exp Exp Exp 13 | | Var_Exp Identifier 14 | | Let_Exp Identifier Exp Exp 15 | | Letrec_Exp Type Identifier Identifier Type Exp Exp -- letrec f(x) = ... recusive expr ... 16 | | Proc_Exp Identifier Type Exp -- proc 17 | | Call_Exp Exp Exp -- call 18 | deriving Show 19 | 20 | type Identifier = String 21 | 22 | data Type = 23 | TyInt 24 | | TyBool 25 | | TyFun Type Type 26 | deriving (Show, Eq) 27 | 28 | 29 | -- for parser 30 | data AST = 31 | ASTExp { fromASTExp :: Exp } 32 | | ASTType { fromASTType :: Type } 33 | deriving Show 34 | 35 | toASTExp exp = ASTExp exp 36 | 37 | toASTType ty = ASTType ty 38 | 39 | 40 | -- for testing the type checker 41 | type TestCaseName = String 42 | type ExprText = String 43 | 44 | data TypeDeclTestCase = TDTC TestCaseName ExprText (Maybe Type) 45 | 46 | data TypeDeclTestSuite = TypeDeclTestSuite [ TypeDeclTestCase ] 47 | 48 | 49 | -------------------------------------------------------------------------------- /ch7/app/checkedlang/Interp.hs: -------------------------------------------------------------------------------- 1 | module Interp where 2 | 3 | import Expr 4 | import Env 5 | 6 | -- 7 | value_of :: Exp -> Env -> ExpVal 8 | 9 | value_of (Const_Exp n) env = Num_Val n 10 | 11 | value_of (Var_Exp var) env = apply_env env var 12 | 13 | value_of (Diff_Exp exp1 exp2) env = 14 | let val1 = value_of exp1 env 15 | val2 = value_of exp2 env 16 | 17 | num1 = expval_num val1 18 | num2 = expval_num val2 19 | in Num_Val (num1 - num2) 20 | 21 | value_of (IsZero_Exp exp) env = 22 | let val1 = value_of exp env in 23 | let num1 = expval_num val1 in 24 | if num1 == 0 25 | then Bool_Val True 26 | else Bool_Val False 27 | 28 | value_of (If_Exp exp1 exp2 exp3) env = 29 | let val1 = value_of exp1 env in 30 | if expval_bool val1 31 | then value_of exp2 env 32 | else value_of exp3 env 33 | 34 | value_of (Let_Exp var exp1 body) env = 35 | let val1 = value_of exp1 env in 36 | value_of body (extend_env var val1 env) 37 | 38 | value_of (Letrec_Exp ty proc_name bound_var bvar_ty proc_body letrec_body) env = 39 | value_of letrec_body (extend_env_rec proc_name bound_var proc_body env) 40 | 41 | value_of (Proc_Exp var ty body) env = 42 | Proc_Val (procedure var body env) 43 | 44 | value_of (Call_Exp rator rand) env = 45 | apply_procedure proc arg 46 | where proc = expval_proc (value_of rator env) 47 | arg = value_of rand env 48 | 49 | 50 | -- 51 | value_of_program :: Exp -> ExpVal 52 | 53 | value_of_program exp = value_of exp initEnv 54 | 55 | 56 | -- 57 | initEnv = extend_env "i" (Num_Val 1) 58 | (extend_env "v" (Num_Val 5) 59 | (extend_env "x" (Num_Val 10) empty_env)) 60 | 61 | -- 62 | apply_procedure :: Proc -> ExpVal -> ExpVal 63 | apply_procedure proc arg = 64 | value_of (body proc) (extend_env (var proc) arg (saved_env proc)) 65 | -------------------------------------------------------------------------------- /ch7/app/checkedlang/Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer(lexerSpec) where 2 | 3 | import Prelude hiding (EQ) 4 | import CommonParserUtil 5 | import Token 6 | 7 | mkFn :: Token -> LexAction Token IO () 8 | mkFn tok = \text -> return $ Just tok 9 | 10 | skip :: LexAction Token IO () 11 | skip = \text -> return $ Nothing 12 | 13 | lexerSpec :: LexerSpec Token IO () 14 | lexerSpec = LexerSpec 15 | { 16 | endOfToken = END_OF_TOKEN, 17 | lexerSpecList = 18 | [ ("[ \t\n]" , skip), 19 | 20 | ("[0-9]+" , mkFn INTEGER_NUMBER), 21 | 22 | ("->" , mkFn ARROW), 23 | 24 | ("\\-" , mkFn SUB), 25 | ("\\(" , mkFn OPEN_PAREN), 26 | ("\\)" , mkFn CLOSE_PAREN), 27 | ("\\," , mkFn COMMA), 28 | 29 | (":" , mkFn COLON), 30 | 31 | ("zero\\?" , mkFn ISZERO), 32 | 33 | ("if" , mkFn IF), 34 | ("then" , mkFn THEN), 35 | ("else" , mkFn ELSE), 36 | 37 | ("letrec" , mkFn LETREC), 38 | 39 | ("int" , mkFn TYINT), 40 | ("bool" , mkFn TYBOOL), 41 | 42 | ("let" , mkFn LET), 43 | ("in" , mkFn IN), 44 | ("\\=" , mkFn EQ), 45 | 46 | ("proc" , mkFn PROC), 47 | 48 | 49 | ("[a-zA-Z][a-zA-Z0-9]*" , mkFn IDENTIFIER) 50 | ] 51 | } 52 | -------------------------------------------------------------------------------- /ch7/app/checkedlang/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | import TypeCheck 12 | 13 | import Control.Monad (when) 14 | import System.IO 15 | import System.Environment (getArgs, withArgs) 16 | 17 | main :: IO () 18 | main = 19 | do args <- getArgs 20 | _main args 21 | 22 | 23 | _main [] = return () 24 | _main (fileName:args) = 25 | case fileName of 26 | _ -> do _ <- doProcess True fileName 27 | _main args 28 | 29 | 30 | doProcess verbose fileName = do 31 | text <- readFile fileName 32 | let debugFlag = False 33 | 34 | expressionAst <- 35 | parsing debugFlag 36 | parserSpec ((), 1, 1, text) 37 | (aLexer lexerSpec) 38 | (fromToken (endOfToken lexerSpec)) 39 | 40 | let expression = fromASTExp expressionAst 41 | 42 | putStrLn (show expression) 43 | 44 | eitherTyOrErr <- typeCheck expression 45 | case eitherTyOrErr of 46 | Right ty -> 47 | do putStrLn (show ty) 48 | 49 | let val = value_of_program expression 50 | putStrLn (show val) 51 | 52 | Left errMsg -> 53 | do putStrLn errMsg 54 | 55 | -- 56 | -- parser text = do 57 | -- parsing False -- parser converting a text-based program 58 | -- parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 59 | -- (aLexer lexerSpec) 60 | -- (fromToken (endOfToken lexerSpec)) 61 | 62 | -- run text = do 63 | -- expression <- parser text 64 | -- 65 | -- putStrLn (show expression) 66 | -- 67 | -- let val = value_of_program expression -- interpreter 68 | -- putStrLn (show val) 69 | 70 | -------------------------------------------------------------------------------- /ch7/app/checkedlang/MainUtil.hs: -------------------------------------------------------------------------------- 1 | module MainUtil where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | parser text = do 17 | parsing False -- parser converting a text-based program 18 | parserSpec ((), 1, 1, text) -- into a program in abstract syntax tree (Expr) 19 | (aLexer lexerSpec) 20 | (fromToken (endOfToken lexerSpec)) 21 | 22 | run text = do 23 | val <- runProg text True 24 | putStrLn (show val) 25 | 26 | runProg text bool = do 27 | expressionAst <- parser text 28 | let expression = fromASTExp expressionAst 29 | 30 | if bool then putStrLn (show expression) else return () 31 | 32 | let val = value_of_program expression -- interpreter 33 | return val 34 | -------------------------------------------------------------------------------- /ch7/ch7.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.36.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: ch7 8 | version: 0.1.0.0 9 | description: Please see the README on GitHub at 10 | homepage: https://github.com/kwanghoon/Lecture_EOPL_Exercise#readme 11 | bug-reports: https://github.com/kwanghoon/Lecture_EOPL_Exercise/issues 12 | author: Kwanghoon Choi 13 | maintainer: lazyswamp@gmail.com 14 | copyright: 2024 Kwanghoon Choi 15 | license: BSD3 16 | license-file: LICENSE 17 | build-type: Simple 18 | extra-source-files: 19 | README.md 20 | CHANGELOG.md 21 | 22 | source-repository head 23 | type: git 24 | location: https://github.com/kwanghoon/Lecture_EOPL_Exercise 25 | subdir: ch7 26 | 27 | library 28 | exposed-modules: 29 | Lib 30 | other-modules: 31 | Paths_ch7 32 | hs-source-dirs: 33 | src 34 | build-depends: 35 | base >=4.7 && <5 36 | , containers 37 | , hspec 38 | , yapb >=0.2.3 39 | default-language: Haskell2010 40 | 41 | executable checkedlang-exe 42 | main-is: Main.hs 43 | other-modules: 44 | Env 45 | Expr 46 | Interp 47 | Lexer 48 | MainUtil 49 | Parser 50 | Token 51 | TypeCheck 52 | Paths_ch7 53 | hs-source-dirs: 54 | app/checkedlang 55 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 56 | build-depends: 57 | base >=4.7 && <5 58 | , ch7 59 | , containers 60 | , hspec 61 | , yapb >=0.2.3 62 | default-language: Haskell2010 63 | 64 | test-suite checkedlang-test 65 | type: exitcode-stdio-1.0 66 | main-is: Spec.hs 67 | other-modules: 68 | TypeCheckerTest 69 | Env 70 | Expr 71 | Interp 72 | Lexer 73 | Main 74 | MainUtil 75 | Parser 76 | Token 77 | TypeCheck 78 | Paths_ch7 79 | hs-source-dirs: 80 | test/checkedlang 81 | app/checkedlang 82 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 83 | build-depends: 84 | base >=4.7 && <5 85 | , ch7 86 | , containers 87 | , hspec 88 | , yapb >=0.2.3 89 | default-language: Haskell2010 90 | -------------------------------------------------------------------------------- /ch7/dist-newstyle/cache/config: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kwanghoon/Lecture_EOPL_Exercise/01a2e43ace744fc96100a0ee6eb165883a557d03/ch7/dist-newstyle/cache/config -------------------------------------------------------------------------------- /ch7/package.yaml: -------------------------------------------------------------------------------- 1 | name: ch7 2 | version: 0.1.0.0 3 | github: "kwanghoon/Lecture_EOPL_Exercise/ch7" 4 | license: BSD3 5 | author: "Kwanghoon Choi" 6 | maintainer: "lazyswamp@gmail.com" 7 | copyright: "2024 Kwanghoon Choi" 8 | 9 | extra-source-files: 10 | - README.md 11 | - CHANGELOG.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - yapb >= 0.2.3 25 | - hspec 26 | - containers 27 | 28 | # ghc-options: 29 | # - -Wall 30 | # - -Wcompat 31 | # - -Widentities 32 | # - -Wincomplete-record-updates 33 | # - -Wincomplete-uni-patterns 34 | # - -Wmissing-export-lists 35 | # - -Wmissing-home-modules 36 | # - -Wpartial-fields 37 | # - -Wredundant-constraints 38 | 39 | library: 40 | source-dirs: src 41 | 42 | executables: 43 | checkedlang-exe: 44 | main: Main.hs 45 | source-dirs: 46 | - app/checkedlang 47 | ghc-options: 48 | - -threaded 49 | - -rtsopts 50 | - -with-rtsopts=-N 51 | dependencies: 52 | - ch7 53 | 54 | tests: 55 | checkedlang-test: 56 | main: Spec.hs 57 | source-dirs: 58 | - test/checkedlang 59 | - app/checkedlang 60 | ghc-options: 61 | - -threaded 62 | - -rtsopts 63 | - -with-rtsopts=-N 64 | dependencies: 65 | - ch7 66 | -------------------------------------------------------------------------------- /ch7/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) where 4 | 5 | someFunc :: IO () 6 | someFunc = putStrLn "someFunc" 7 | -------------------------------------------------------------------------------- /ch7/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: yapb-0.2.3@sha256:d219b1ff4195682af24ae07b415b119ff164281444f0bcfcac9ed8550c850f40,4744 9 | pantry-tree: 10 | sha256: 1e339417bc7a35c381209900cfbb127259c0228048f63f66c85b65f5dbb670d6 11 | size: 3920 12 | original: 13 | hackage: yapb-0.2.3 14 | snapshots: 15 | - completed: 16 | sha256: cbd5e8593869445794924668479b5bd9f1738d075898623dceacc13b2576b6e3 17 | size: 617355 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/1.yaml 19 | original: 20 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/1.yaml 21 | -------------------------------------------------------------------------------- /ch7/test/checkedlang/Spec.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Expr 4 | import TypeCheck 5 | import TypeCheckerTest 6 | 7 | import CommonParserUtil 8 | import TokenInterface 9 | import Lexer 10 | import Parser 11 | 12 | import Test.Hspec 13 | import Control.Exception(try, throw, SomeException) 14 | 15 | main :: IO () 16 | main = 17 | hspec $ do 18 | describe "exceptions" $ do 19 | let atdir f = "checkedlang:" ++ f 20 | let TypeDeclTestSuite typechecker_tests' = typechecker_tests 21 | 22 | mapM_ 23 | (\tdtcArg@(TDTC tcname _ maybeResult) -> 24 | (it(atdir(tcname)) $ do 25 | result <- try (doTest tdtcArg) :: IO (Either SomeException ()) 26 | case result of 27 | Left exn -> throw exn `shouldBe` maybeResult 28 | Right () -> putStr "" 29 | ) 30 | ) 31 | typechecker_tests' 32 | 33 | doTest (TDTC tcname expr_text maybeResult) = 34 | do -- putStr $ tcname ++ " : " 35 | 36 | expressionAst <- 37 | parsing False 38 | parserSpec ((), 1, 1, expr_text) 39 | (aLexer lexerSpec) 40 | (fromToken (endOfToken lexerSpec)) 41 | 42 | let expression = fromASTExp expressionAst 43 | 44 | -- Just to add the type of x! 45 | case maybeResult of 46 | Just ty' -> 47 | do eitherTyOrErr <- typeCheck (Let_Exp "x" (Const_Exp 1) expression) 48 | case eitherTyOrErr of 49 | Left errMsg -> 50 | putStrLn ("Expected " ++ show ty' ++ " but got " ++ errMsg ++ " in " ++ show expression) 51 | Right ty -> 52 | if equalType ty ty' 53 | then putStr "" -- putStrLn "Successfully typechecked." 54 | else putStrLn ("Expected " ++ show ty' ++ " but got " ++ show ty ++ " in " ++ show expression) 55 | Nothing -> 56 | do eitherTyOrErr <- typeCheck (Let_Exp "x" (Const_Exp 1) expression) 57 | case eitherTyOrErr of 58 | Left errMsg -> putStr "" -- putStrLn "Successfully type-unchecked." -- Is it the same error? 59 | Right ty -> putStr "" -- putStrLn "Should not be typechecked." 60 | -------------------------------------------------------------------------------- /ch9/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for `ch9` 2 | 3 | All notable changes to this project will be documented in this file. 4 | 5 | The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), 6 | and this project adheres to the 7 | [Haskell Package Versioning Policy](https://pvp.haskell.org/). 8 | 9 | ## Unreleased 10 | 11 | ## 0.1.0.0 - YYYY-MM-DD 12 | -------------------------------------------------------------------------------- /ch9/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2024 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /ch9/README.md: -------------------------------------------------------------------------------- 1 | # ch9 2 | -------------------------------------------------------------------------------- /ch9/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ch9/app/classes/Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer(lexerSpec) where 2 | 3 | import Prelude hiding (EQ) 4 | import CommonParserUtil 5 | import Token 6 | 7 | import qualified Data.Map as Map 8 | 9 | mkFn :: Token -> LexAction Token IO () 10 | mkFn tok = \text -> return $ Just tok 11 | 12 | skip :: LexAction Token IO () 13 | skip = \text -> return $ Nothing 14 | 15 | lexerSpec :: LexerSpec Token IO () 16 | lexerSpec = LexerSpec 17 | { 18 | endOfToken = END_OF_TOKEN, 19 | lexerSpecList = 20 | [ 21 | ("%[^\n]*\n", skip), -- Comment: % bla bla bla ... 22 | ("[ \t\n]" , skip), 23 | 24 | ("[0-9]+" , mkFn INTEGER_NUMBER), 25 | 26 | ("\\-" , mkFn SUB), 27 | ("\\+" , mkFn PLUS), 28 | ("\\(" , mkFn OPEN_PAREN), 29 | ("\\)" , mkFn CLOSE_PAREN), 30 | ("\\," , mkFn COMMA), 31 | 32 | ("zero\\?" , mkFn ISZERO), 33 | 34 | ("\\=" , mkFn EQ), 35 | (";" , mkFn SEMICOLON), 36 | 37 | ("[_a-zA-Z][_a-zA-Z0-9]*" , keywordOrIdentifier) 38 | ] 39 | } 40 | 41 | keywordMap :: Map.Map String Token 42 | keywordMap = Map.fromList (map swap keywords) 43 | where swap (a,b) = (b,a) 44 | 45 | keywordOrIdentifier :: Monad m => String -> m (Maybe Token) 46 | keywordOrIdentifier text = 47 | case Map.lookup text keywordMap of 48 | Nothing -> return $ Just IDENTIFIER 49 | Just tok -> return $ Just tok 50 | 51 | -------------------------------------------------------------------------------- /ch9/app/classes/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import CommonParserUtil 4 | 5 | import TokenInterface 6 | import Lexer 7 | import Terminal 8 | import Parser 9 | import Expr 10 | import Interp 11 | 12 | import Control.Monad (when) 13 | import System.IO 14 | import System.Environment (getArgs, withArgs) 15 | 16 | main :: IO () 17 | main = 18 | do args <- getArgs 19 | _main args 20 | 21 | 22 | _main [] = return () 23 | _main (fileName:args) = 24 | case fileName of 25 | "test" -> return () 26 | _ -> do _ <- doProcess True fileName 27 | _main args 28 | 29 | 30 | doProcess verbose fileName = do 31 | text <- readFile fileName 32 | let debugFlag = False 33 | 34 | tree <- 35 | parsing debugFlag 36 | parserSpec ((),1,1,text) 37 | (aLexer lexerSpec) 38 | (fromToken (endOfToken lexerSpec)) 39 | 40 | let program = programFrom tree 41 | 42 | print program 43 | 44 | let val = value_of_program program 45 | print val 46 | -------------------------------------------------------------------------------- /ch9/app/classes/Ref.hs: -------------------------------------------------------------------------------- 1 | module Ref where 2 | 3 | type Location = Integer -------------------------------------------------------------------------------- /ch9/ch9.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.36.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: ch9 8 | version: 0.1.0.0 9 | description: Please see the README on GitHub at 10 | homepage: https://github.com/kwanghoon/Lecture_EOPL_Exercise#readme 11 | bug-reports: https://github.com/kwanghoon/Lecture_EOPL_Exercise/issues 12 | author: Kwanghoon Choi 13 | maintainer: lazyswamp@gmail.com 14 | copyright: 2024 Kwanghoon Choi 15 | license: BSD-3-Clause 16 | license-file: LICENSE 17 | build-type: Simple 18 | extra-source-files: 19 | README.md 20 | CHANGELOG.md 21 | 22 | source-repository head 23 | type: git 24 | location: https://github.com/kwanghoon/Lecture_EOPL_Exercise 25 | subdir: ch9 26 | 27 | library 28 | exposed-modules: 29 | Lib 30 | other-modules: 31 | Paths_ch9 32 | autogen-modules: 33 | Paths_ch9 34 | hs-source-dirs: 35 | src 36 | build-depends: 37 | base >=4.7 && <5 38 | , containers 39 | , hspec 40 | , yapb >=0.2.3 41 | default-language: Haskell2010 42 | 43 | executable classes-exe 44 | main-is: Main.hs 45 | other-modules: 46 | EnvStore 47 | Expr 48 | Interp 49 | Lexer 50 | Parser 51 | Ref 52 | Token 53 | Paths_ch9 54 | autogen-modules: 55 | Paths_ch9 56 | hs-source-dirs: 57 | app/classes 58 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 59 | build-depends: 60 | base >=4.7 && <5 61 | , ch9 62 | , containers 63 | , hspec 64 | , yapb >=0.2.3 65 | default-language: Haskell2010 66 | 67 | test-suite classes-test 68 | type: exitcode-stdio-1.0 69 | main-is: Spec.hs 70 | other-modules: 71 | EnvStore 72 | Expr 73 | Interp 74 | Lexer 75 | Main 76 | Parser 77 | Ref 78 | Token 79 | Paths_ch9 80 | autogen-modules: 81 | Paths_ch9 82 | hs-source-dirs: 83 | test/classes 84 | app/classes 85 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 86 | build-depends: 87 | base >=4.7 && <5 88 | , ch9 89 | , containers 90 | , hspec 91 | , yapb >=0.2.3 92 | default-language: Haskell2010 93 | -------------------------------------------------------------------------------- /ch9/dist-newstyle/cache/config: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kwanghoon/Lecture_EOPL_Exercise/01a2e43ace744fc96100a0ee6eb165883a557d03/ch9/dist-newstyle/cache/config -------------------------------------------------------------------------------- /ch9/package.yaml: -------------------------------------------------------------------------------- 1 | name: ch9 2 | version: 0.1.0.0 3 | github: "kwanghoon/Lecture_EOPL_Exercise/ch9" 4 | license: BSD-3-Clause 5 | author: "Kwanghoon Choi" 6 | maintainer: "lazyswamp@gmail.com" 7 | copyright: "2024 Kwanghoon Choi" 8 | 9 | extra-source-files: 10 | - README.md 11 | - CHANGELOG.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - yapb >= 0.2.3 25 | - hspec 26 | - containers 27 | 28 | # ghc-options: 29 | # - -Wall 30 | # - -Wcompat 31 | # - -Widentities 32 | # - -Wincomplete-record-updates 33 | # - -Wincomplete-uni-patterns 34 | # - -Wmissing-export-lists 35 | # - -Wmissing-home-modules 36 | # - -Wpartial-fields 37 | # - -Wredundant-constraints 38 | 39 | library: 40 | source-dirs: src 41 | 42 | executables: 43 | classes-exe: 44 | main: Main.hs 45 | source-dirs: app/classes 46 | ghc-options: 47 | - -threaded 48 | - -rtsopts 49 | - -with-rtsopts=-N 50 | dependencies: 51 | - ch9 52 | 53 | tests: 54 | classes-test: 55 | main: Spec.hs 56 | source-dirs: 57 | - test/classes 58 | - app/classes 59 | ghc-options: 60 | - -threaded 61 | - -rtsopts 62 | - -with-rtsopts=-N 63 | dependencies: 64 | - ch9 65 | -------------------------------------------------------------------------------- /ch9/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) where 4 | 5 | someFunc :: IO () 6 | someFunc = putStrLn "someFunc" 7 | -------------------------------------------------------------------------------- /ch9/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: yapb-0.2.3@sha256:d219b1ff4195682af24ae07b415b119ff164281444f0bcfcac9ed8550c850f40,4744 9 | pantry-tree: 10 | sha256: 1e339417bc7a35c381209900cfbb127259c0228048f63f66c85b65f5dbb670d6 11 | size: 3920 12 | original: 13 | hackage: yapb-0.2.3 14 | snapshots: 15 | - completed: 16 | sha256: cbd5e8593869445794924668479b5bd9f1738d075898623dceacc13b2576b6e3 17 | size: 617355 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/1.yaml 19 | original: 20 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/1.yaml 21 | -------------------------------------------------------------------------------- /ch9/test/classes/Spec.hs: -------------------------------------------------------------------------------- 1 | module Spec where 2 | 3 | main :: IO () 4 | main = putStrLn "Test suite not yet implemented" --------------------------------------------------------------------------------